Saving an array to new workbook

Question

Scenario: I have a workbook with multiple worksheets. I am trying to use a function (called within a sub) to export arrays with data from certain worksheets. The arrays are created before the function with the content from the worksheet with:

If ws.Name = "AA" Then
            expaa = ws.UsedRange.Value
End if

where expaa is previously defined as variant.

The function I am using apparently finishes running, but the output on the new file saved is weird: instead of having one row of headers, the first row is split into 2 for some reason (all the others remain the same).

This is the function I am using:

Function Exporter(arr As Variant, y As String, OutPath As String) As Variant
    Dim lrow As Long, lColumn As Long
    Dim w2 As Workbook
    Dim d As Date

    Workbooks.Add
    Set w2 = ActiveWorkbook

    w2.Worksheets(1).Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr       
    Application.DisplayAlerts = False
    w2.SaveAs Filename:=OutPath & "\" & y, FileFormat:=6
    Application.DisplayAlerts = True

    w2.Close True

End Function

Which I call from the main sub with:

If aa_name <> "" Then
    Exporter expaa , "aa_OK", wbpath
End If

where aa_name is the name of the file used to retrieve the path.

Obs: The wbpath variable is a string with the path of my main workbook (therefore the new file is saved at the same location).

Question: What may be causing the first row of my output to be split? How can that be fixed?

Obs2: I know this can be done with copy procedure, and looping through the array and so on. I even got it to work with other methods. This post is only to understand what I am doing wrong with the current code.

Obs3: Regarding the data that is going to be passed: it is a matrix of days, identifiers and data, ex:

               Item1      Item2     Item3
01/01/2000      1           1         2
02/01/2000      1           2         1
03/01/2000      2           2         2

with around 2000 rows and 3000 columns.

UPDATE: After retesting the code multiple times, It appears that the data of the first row only gets split when the file is save as csv (when the array is pasted, the output is normal). Any idea on what may be the cause for that?

Answer 1

I know this is old but here is my solution for the googlers. This accepts an array and creates a CSV at a path you define. Its probably not perfect but it has worked so far for me.

Option Explicit
Option Private Module

Public Function SaveTextToFile(ByVal targetarray As Variant, ByVal filepath As String) As Boolean
    On Error GoTo CouldNotMakeFile
    
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    Dim fileStream As TextStream

    ' Here the actual file is created and opened for write access
    Set fileStream = fso.CreateTextFile(filepath)

    ' Write something to the file
    Dim Row As Long, Col As Long
    
    For Row = LBound(targetarray, 1) To UBound(targetarray, 1)
        For Col = LBound(targetarray, 2) To UBound(targetarray, 2)
            fileStream.Write StringCompliance(targetarray(Row, Col)) & IIf(Col = UBound(targetarray, 2), "", ",")
        Next Col
        fileStream.WriteBlankLines 1
    Next Row

    ' Close it, so it is not locked anymore
    fileStream.Close

    ' Here is another great method of the FileSystemObject that checks if a file exists
    If fso.FileExists(filepath) Then
        SaveTextToFile = True
    End If
    
CouldNotMakeFile:
End Function

Private Function StringCompliance(ByVal InputString As String) As String

    Dim CurrentString As String
    CurrentString = InputString

    'Test if string has qoutes
    If InStr(CurrentString, Chr$(34)) > 0 Then
        CurrentString = Chr$(34) & Replace(CurrentString, Chr$(34), Chr$(34) & Chr$(34)) & Chr$(34)
        StringCompliance = True
    Else
        'Tets if string has commas or line breaks
        If InStr(CurrentString, ",") > 0 Or InStr(CurrentString, vbLf) > 0 Then
            CurrentString = Chr$(34) & CurrentString & Chr$(34)
        Else
            StringCompliance = False
        End If
    End If
    
    StringCompliance = CurrentString
    
End Function