Help please - Macro to help save excel as CSV and remove blank rows..

[Stuhelhall]

Hi,

I have the existing VBA code (see below) to create a CSV file from a excel sheet and this work well, however the problem is the software that reads the CSV file does not like data missing in rows or enire blank rows.

Therefore I need a macro that would amend the new CSV file as it is been created to remove entire rows when data is not present in column A.

Is this possible?

Sub CopyToCSV()
Dim MyPath As String
Dim MyFileName As String
'The path and file names:
MyPath = "C:\V10\demo\import\"
MyFileName = Sheets(1).Cells(1, 1).Value
'Makes sure the path name ends with "\":
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
'Makes sure the filename ends with ".csv"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
'Copies the sheet to a new workbook:
Sheets("upload").Copy
'The new workbook becomes Activeworkbook:
With ActiveWorkbook
'Saves the new workbook to given folder / filename:
.SaveAs Filename:= _
MyPath & MyFileName, _
FileFormat:=xlCSV, _
CreateBackup:=False
'Closes the file
.Close False
End With
End Sub

Thanks in anticipation.

Stuart

 

[baitmaster]

try this. I haven't tested it because I'm already in the middle of a long code run

Option Explicit

Sub CopyToCSV()

'path name
Const MyPath As String = "C:\V10\demo\import\" 'NOTE: must end with "\"

' file name
Dim MyFileName As String: MyFileName = Sheets(1).Cells(1, 1).Value
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv" 'Makes sure the filename ends with ".csv"

'Copies the sheet to a new workbook:
Sheets("upload").Copy

'The new workbook becomes Activeworkbook:
With ActiveWorkbook
    
    removeRows
    
    'Saves the new workbook to given folder / filename:
    .SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlCSV, CreateBackup:=False
    
    'Closes the file
    .Close False
End With

End Sub

Sub removeRows()
Dim i As Long

With Application
    
    ' speed up processing
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    
    ' start at bottom and work up, deleting empty rows
    For i = lastUsedRow(ActiveSheet) To 1 Step -1
        If WorksheetFunction.CountA(ActiveSheet.Rows(i)) = 0 Then ActiveSheet.Rows(i).Delete shift:=xlUp
    Next i
    
    ' put settings back as were
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    
End Sub

Function lastUsedRow(ws As Worksheet) As Long
' finds the actual last used row of the worksheet

On Error Resume Next
    lastUsedRow = ws.Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
On Error GoTo 0

End Function

 

[baitmaster]

Correction required:

Sub removeRows()
Dim i As Long

With Application
    
    ' speed up processing
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    
    ' start at bottom and work up, deleting empty rows
    For i = lastUsedRow(ActiveSheet) To 1 Step -1
        If WorksheetFunction.CountA(ActiveSheet.Rows(i)) = 0 Then ActiveSheet.Rows(i).Delete shift:=xlUp
    Next i
    
    ' put settings back as were
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True

[B]End With[/B]    
End Sub

 

[Stuhelhall]

Thanks Baitmaster,

I tried your code but it shows as two Marco's, I wanted to send you my sopreadhseet so you can see what I am trying today, is this possible?

Code I tried is as below:-

Option Explicit


Sub CopyToCSV()


'path name
Const MyPath As String = "C:\V10\demo\import\" 'NOTE: must end with "\"


' file name
Dim MyFileName As String: MyFileName = Sheets(1).Cells(1, 1).Value
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv" 'Makes sure the filename ends with ".csv"


'Copies the sheet to a new workbook:
Sheets("upload").Copy


'The new workbook becomes Activeworkbook:
With ActiveWorkbook

removeRows

'Saves the new workbook to given folder / filename:
.SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlCSV, CreateBackup:=False

'Closes the file
.Close False
End With


End Sub


Sub removeRows()
Dim i As Long


With Application

' speed up processing
.Calculation = xlCalculationManual
.ScreenUpdating = False

' start at bottom and work up, deleting empty rows
For i = lastUsedRow(ActiveSheet) To 1 Step -1
If WorksheetFunction.CountA(ActiveSheet.Rows(i)) = 0 Then ActiveSheet.Rows(i).Delete shift:=xlUp
Next i

' put settings back as were
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True


End With
End Sub

 

[baitmaster]

Sorry I'm on a secure network and can't accept your file nor download it from anywhere

Yes there are several macros. You'll note that the CopyToCSV macro calls the removeRows macro, which in turn uses the lastUsedRow function. This is for simplicity and efficiency - its better to have several smaller subs/functions than one large complex one

Aside from that you simply run the CopyToCSV routine exactly like you currently do. Is it not working as you expect, and if not what is wrong?

 

[Stuhelhall]

Thanks for the reply.

When I run the marco I get a compile error on the following line error states "Sub or Function not defined?

' start at bottom and work up, deleting empty rows
For i = lastUsedRow(ActiveSheet) To 1 Step -1
If WorksheetFunction.CountA(ActiveSheet.Rows(i)) = 0 Then ActiveSheet.Rows(i).Delete shift:=xlUp
Next i

Thanks

Stuart

 

[baitmaster]

it looks like the function lastUsedRow has been removed from your code. My guess is that I posted a correction for part of the code, but you interpreted as a replacement for all of the code

You'll still need the function shown in my original post, sorry for any confusion