0
votes

I am working on finding a solution that will handle adding some pre-determined headers to a CSV file that gets exported from an Excel worksheet. I am applying a solution added by BruceWayne and when I apply the VBA code to my current Excel worksheet, it adds the headers to the Excel spreadsheet itself.

I am trying to find a way to have this VBA code be applied to the exported CSV file itself and not the Excel spreadsheet. My VBA code currently looks as such:

Sub WriteCSVFile()

Dim My_filenumber As Integer
Dim logSTR As String

My_filenumber = FreeFile

logSTR = logSTR & Cells(18, "C").Value & " , "
logSTR = logSTR & Cells(19, "C").Value & " , "
logSTR = logSTR & Cells(20, "C").Value & " , "
logSTR = logSTR & Cells(21, "C").Value & " , "
logSTR = logSTR & Cells(22, "C").Value & " , "
logSTR = logSTR & Cells(26, "C").Value & " , "
logSTR = logSTR & Cells(27, "C").Value & " , "
logSTR = logSTR & Cells(28, "C").Value & " , "
logSTR = logSTR & Cells(29, "C").Value & " , "
logSTR = logSTR & Cells(30, "C").Value & " , "
logSTR = logSTR & Cells(31, "C").Value & " , "
logSTR = logSTR & Cells(32, "C").Value & " , "
logSTR = logSTR & Cells(36, "C").Value & " , "
logSTR = logSTR & Cells(37, "C").Value & " , "
logSTR = logSTR & Cells(38, "C").Value & " , "
logSTR = logSTR & Cells(39, "C").Value & " , "
logSTR = logSTR & Cells(40, "C").Value & " , "
logSTR = logSTR & Cells(41, "C").Value & " , "
logSTR = logSTR & Cells(42, "C").Value & " , "
logSTR = logSTR & Cells(46, "C").Value & " , "
logSTR = logSTR & Cells(47, "C").Value & " , "
logSTR = logSTR & Cells(48, "C").Value & " , "
logSTR = logSTR & Cells(49, "C").Value & " , "
logSTR = logSTR & Cells(50, "C").Value & " , "
logSTR = logSTR & Cells(51, "C").Value & " , "
logSTR = logSTR & Cells(52, "C").Value & " , "

Open "Z:\SHARE DRIVE\RequestDirectory\" & ThisWorkbook.Name & ".csv" For Append As #My_filenumber
    Print #My_filenumber, logSTR
Close #My_filenumber

End Sub

When I combine the 2 VBA codes together by removing the 'End Sub' at the end of one or the other, I receive an error and must re-add the line to have the code apply successfully; however, in doing such the codes must be applied separately and then the headers are added to the Excel worksheet itself:

Sub AddHeaders()
Dim headers() As Variant
Dim ws As Worksheet
Dim wb As Workbook

Application.ScreenUpdating = False 'turn this off for the macro to run a little faster

Set wb = ActiveWorkbook

headers() = Array("Header1", "Header2", "Header3", "Header4", "Header5", "Header6",
    "Header7", "Header8", "Header9", "Header10", "Header11", "Header12")
For Each ws In wb.Sheets
    With ws
    .Rows(1).Value = "" 'This will clear out row 1
    For i = LBound(headers()) To UBound(headers())
        .Cells(1, 1 + i).Value = headers(i)
    Next i
    .Rows(1).Font.Bold = True
    End With
Next ws

Application.ScreenUpdating = True 'turn it back on

MsgBox ("Done!")


End Sub

I am wondering if there is a straightforward way of applying the VBA code that handles the adding of the headers along with the data being exported from the Excel worksheet to the CSV file without separating the 2 VBA codes?

Thank you for any information you may provide

2
Can you post content of this error?Limak
The error reads - Compile Error: Expected End SubNeedToKnowBasis22
Have you removed also beginning of new macro, for example Sub AddHeaders()?Limak
I just attempted to do as you suggested - the 2 combined VBA codes were able to execute successfully but the headers were still applied to the Excel worksheet and not the exported CSV document.NeedToKnowBasis22

2 Answers

1
votes

AddHeaders is designed to add a row of headings to the worksheet. You won't change what it does simply by making it part of the other subroutine. WriteCSVFile writes a series of values to the text file, to create the CSV. You can't readily combine the two, but you can add some of the code from the former to the latter, like this.

logSTR = logSTR & "header1" & " , "
logSTR = logSTR & "header2" & " , "
logSTR = logSTR & "header3" & " , "
logSTR = logSTR & "header4" & " , "
'continue for each header

logSTR = logSTR & Chr(13)

etc.

Add this code IN FRONT of the line that says

logSTR = logSTR & Cells(18, "C").Value & " , "
0
votes

Can you try to put Close on teh end of the second macro?

Sub WriteCSVFile()

Dim My_filenumber As Integer
Dim logSTR As String

My_filenumber = FreeFile

logSTR = logSTR & Cells(18, "C").Value & " , "
logSTR = logSTR & Cells(19, "C").Value & " , "
logSTR = logSTR & Cells(20, "C").Value & " , "
logSTR = logSTR & Cells(21, "C").Value & " , "
logSTR = logSTR & Cells(22, "C").Value & " , "
logSTR = logSTR & Cells(26, "C").Value & " , "
logSTR = logSTR & Cells(27, "C").Value & " , "
logSTR = logSTR & Cells(28, "C").Value & " , "
logSTR = logSTR & Cells(29, "C").Value & " , "
logSTR = logSTR & Cells(30, "C").Value & " , "
logSTR = logSTR & Cells(31, "C").Value & " , "
logSTR = logSTR & Cells(32, "C").Value & " , "
logSTR = logSTR & Cells(36, "C").Value & " , "
logSTR = logSTR & Cells(37, "C").Value & " , "
logSTR = logSTR & Cells(38, "C").Value & " , "
logSTR = logSTR & Cells(39, "C").Value & " , "
logSTR = logSTR & Cells(40, "C").Value & " , "
logSTR = logSTR & Cells(41, "C").Value & " , "
logSTR = logSTR & Cells(42, "C").Value & " , "
logSTR = logSTR & Cells(46, "C").Value & " , "
logSTR = logSTR & Cells(47, "C").Value & " , "
logSTR = logSTR & Cells(48, "C").Value & " , "
logSTR = logSTR & Cells(49, "C").Value & " , "
logSTR = logSTR & Cells(50, "C").Value & " , "
logSTR = logSTR & Cells(51, "C").Value & " , "
logSTR = logSTR & Cells(52, "C").Value & " , "

Open "Z:\SHARE DRIVE\RequestDirectory\" & ThisWorkbook.Name & ".csv" For Append As #My_filenumber
    Print #My_filenumber, logSTR

Dim headers() As Variant
Dim ws As Worksheet
Dim wb As Workbook

Application.ScreenUpdating = False 'turn this off for the macro to run a little faster

Set wb = ActiveWorkbook

headers() = Array("Header1", "Header2", "Header3", "Header4", "Header5", "Header6",
    "Header7", "Header8", "Header9", "Header10", "Header11", "Header12")
For Each ws In wb.Sheets
    With ws
    .Rows(1).Value = "" 'This will clear out row 1
    For i = LBound(headers()) To UBound(headers())
        .Cells(1, 1 + i).Value = headers(i)
    Next i
    .Rows(1).Font.Bold = True
    End With
Next ws

Application.ScreenUpdating = True 'turn it back on
Close #My_filenumber

End Sub