VBA to save rows as CSV without empty rows

Jorgi

New Member
Joined
Jul 7, 2021
Messages
41
Office Version
  1. 2019
Platform
  1. Windows
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
1634825593353.png

outcome from macro
1634825869136.png
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
60,161
Office Version
  1. 365
Platform
  1. Windows
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.
VBA Code:
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

Well-known Member
Joined
Apr 5, 2021
Messages
1,729
Office Version
  1. 2010
Platform
  1. Windows
Hello, a VBA demonstration to directly export the data from the source worksheet to a csv text file for starters :​
VBA Code:
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
 
Solution

Jorgi

New Member
Joined
Jul 7, 2021
Messages
41
Office Version
  1. 2019
Platform
  1. Windows
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

Well-known Member
Joined
Apr 5, 2021
Messages
1,729
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Try post #3 …​
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
60,161
Office Version
  1. 365
Platform
  1. Windows
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?
Excel Formula:
=COUNTA(B7:G12)
 

Jorgi

New Member
Joined
Jul 7, 2021
Messages
41
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
60,161
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Jul 7, 2021
Messages
41
Office Version
  1. 2019
Platform
  1. Windows
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
60,161
Office Version
  1. 365
Platform
  1. Windows
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.
 

Forum statistics

Threads
1,148,419
Messages
5,746,562
Members
424,032
Latest member
pochie2741

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top