I am trying to save an excel sheet to .csv format with the following macro:
Public Sub WriteCSV()
Set wkb = ActiveSheet
Dim fileName As String
Dim MaxCols As Integer
fileName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
If fileName = "False" Then
End
End If
On Error GoTo eh
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Charset = "UTF-8"
BinaryStream.Type = adTypeText
BinaryStream.Open
For r = 1 To Range("A" & Rows.Count).End(xlUp).Row
s = ""
c = 1
i = 1
For j = 1 To wkb.Cells(1, wkb.Columns.Count).End(xlToLeft).Column
i = i + 1
If Not IsEmpty(wkb.Cells(r, i).Value) Then
s = s & wkb.Cells(r, c).Value & ","
c = c + 1
ElseIf IsEmpty(wkb.Cells(r, i).Value) Then
If wkb.Cells(r, i).Column <> wkb.Cells(1, wkb.Columns.Count).End(xlToLeft).Column Then
s = s & ","
c = c + 1
Else
s = s & wkb.Cells(r, c).Value
c = c + 1
End If
End If
Next j
BinaryStream.WriteText s, 1
Next r
BinaryStream.SaveToFile fileName, adSaveCreateOverWrite
BinaryStream.Close
MsgBox "CSV generated successfully"
eh:
End Sub
The following part of the code needs to be modified so that the commas appear correctly in .csv file even for null values for any given column.
For j = 1 To wkb.Cells(1, wkb.Columns.Count).End(xlToLeft).Column
i = i + 1
If Not IsEmpty(wkb.Cells(r, i).Value) Then
s = s & wkb.Cells(r, c).Value & ","
c = c + 1
ElseIf IsEmpty(wkb.Cells(r, i).Value) Then
If wkb.Cells(r, i).Column <> wkb.Cells(1, wkb.Columns.Count).End(xlToLeft).Column Then
s = s & ","
c = c + 1
Else
s = s & wkb.Cells(r, c).Value
c = c + 1
End If
End If
Next j
I have attached the Sample Sheets. Source sheet and the Result sheet. The Result sheet doesn't provide the required result. Some data are missing and unwanted commas have been added. Please help me to correct the logic in the above piece of code. Thanks!
Bookmarks