VBA to save rows as CSV without empty rows

[Jorgi]

Hello may I ask you to help me with VBA. I would like to save data via macro as CSV but only if there is a data. Every 6 rows equal to one piece of data element but sometimes the 6 rows can be empty (apart from column A) because there is no data and the file will have to be saved without the 6 empty rows. Thank you very much for your help

Initial file

outcome from macro

 

[Joe4]

See if this structure will get you started. This shows you how to loop through the range, 6 columns at a time, and see if any data resides in columns B:G.
I am returning a message box to tell you what ranges meet that condition. You can replace that with code to export the CSV file (you did not tell us the details, i.e. folder locations and file names), so I will leave that part for you to add in.

Sub ExportCSVFiles()

    Dim lr As Long
    Dim r As Long
    Dim rng As Range

'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Set initial value of r
    r = 1

'   Loop through all rows
    Do
'       Build initial range
        Set rng = Range(Cells(r, "B"), Cells(r + 5, "G"))
'       See if any data in range
        If Application.WorksheetFunction.CountA(rng) > 0 Then
'           Export CSV file here
            MsgBox "Create file for range: " & rng.Address(0, 0)
        End If
'       Increment counter
        r = r + 6
'       Exit if past last row
        If r > lr Then Exit Do
    Loop
    
End Sub

 

[Marc L]

Hello, a VBA demonstration to directly export the data from the source worksheet to a csv text file for starters :​

Sub Demo1()
    Dim F%, Rw As Range
        F = FreeFile
        Open ThisWorkbook.Path & "\Export .csv" For Output As #F
    With Application
        For Each Rw In ActiveSheet.UsedRange.Rows
            If .CountA(Rw) > 1 Then Print #F, Join(.Index(Rw.Value2, 1, 0), ",")
        Next
    End With
        Close #F
End Sub

 

[Jorgi]

Thank you very much Joe4 for your code and help. I really appreciate it. I'm more than sure that I'm doing something wrong. I added the export CSV codes as per your instruction/advise. Unfortunately the CSV after saving still include the empty 6 rows.

Export CSV file here
ActiveWorkbook.SaveAs Filename:="C:\...\MyFile.csv", FileFormat:=xlCSV, CreateBackup:=False

I also tried to use different code to save it in the same folder where is the main file but this didn't work either

myCSVFileName = myWB.Path & "\" & "MyFile-" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"

outcome
View attachment 49538

Please forgive me but I'm on the very beginning of my VBA journey and probably doing silly mistakes.

 

[Marc L]

​

Try post #3 …​

 

[Joe4]

Thank you very much Joe4 for your code and help. I really appreciate it. I'm more than sure that I'm doing something wrong. I added the export CSV codes as per your instruction/advise. Unfortunately the CSV after saving still include the empty 6 rows.

Export CSV file here
ActiveWorkbook.SaveAs Filename:="C:\...\MyFile.csv", FileFormat:=xlCSV, CreateBackup:=False

I also tried to use different code to save it in the same folder where is the main file but this didn't work either

myCSVFileName = myWB.Path & "\" & "MyFile-" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"

outcome
View attachment 49538

Please forgive me but I'm on the very beginning of my VBA journey and probably doing silly mistakes.

Is your data structured EXACTLY like what you posted in your example?
If you put this formula in cell H1, can you tell us what it returns?

=COUNTA(B7:G12)

 

[Jorgi]

Marc L - Perfect it works! - I owe you! You helped me second time. How can I learn VBA to be at least half as good as you are. Are there any VBA books or anything to help me to learn VBA programming? Thank you very much.

Joe4 - Yes, the file is structured exactly the same as posted in here. I have put your formula as instructed and it returned "0". I assume it's correct. Thank you very much for your help.

 

[Joe4]

Joe4 - Yes, the file is structured exactly the same as posted in here. I have put your formula as instructed and it returned "0". I assume it's correct. Thank you very much for your help.

I would have to know/see what changes you made to the code you were running.

 

[Jorgi]

I have made only one change. I removed MsgBox "Create file for range: " & rng.Address(0, 0) and replaced it with ActiveWorkbook.SaveAs Filename:="C:\...\MyFile.csv", FileFormat:=xlCSV, CreateBackup:=False
Did I make something wrong with replacing the MsgBox with ActiveWorkbook?

Sub ExportCSVFiles()

Dim lr As Long
Dim r As Long
Dim rng As Range

' Find last row in column A with data
lr = Cells(Rows.Count, "A").End(xlUp).Row

' Set initial value of r
r = 1

' Loop through all rows
Do
' Build initial range
Set rng = Range(Cells(r, "B"), Cells(r + 5, "G"))
' See if any data in range
If Application.WorksheetFunction.CountA(rng) > 0 Then
' Export CSV file here
ActiveWorkbook.SaveAs Filename:="C:\...\MyFile.csv", FileFormat:=xlCSV, CreateBackup:=False
End If
' Increment counter
r = r + 6
' Exit if past last row
If r > lr Then Exit Do
Loop

End Sub

 

[Joe4]

OK, I misunderstood. I thought you were wanting to save each separate 6 row segment as its own CSV file (which is why I mentioned I was unsure how you wanted to name each one).
I didn't realize that you wanted one single CSV file, without the 6 row segments.

It looks like you got a working solution from Marc, so I won't bother coming up with new code to do that his already does.