VBA debugging - cannot delete blank rows

[visualnotsobasic]

Hey Everyone,

I'm new to to VBA and I'm having trouble with one part of my code. I managed to get most of the pieces to work, but I cannot figure out this last piece at all. The basic idea is to have a template worksheet with formulas that will pull data in from a specific folder and then save that into another .xlsx workbook and a .csv (all of this works so far). The problem that I'm running into is that when it saves into a .csv format, I need to have all the blank rows deleted as well as the header so I can drop it into another folder for upload. The blank rows will not delete unfortunately. It was working at some point but then I made some tweaks to the code and I cannot figure out what I did. I've posted the part of the code that I'm having most trouble with.

I would appreciate any and all help!


Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Dim LastRowIndex As Integer
Dim RowIndex As Integer
Dim UsedRng As Range

Set CurrentWB = ActiveWorkbook
Set UsedRng = ActiveSheet.UsedRange
ActiveWorkbook.ActiveSheet.UsedRange.Copy
LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
Application.ScreenUpdating = False

Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

'Delete blank rows in CSV'
Dim i As Long

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True

Rows([1]).EntireRow.Delete

'Save CSV'
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"

Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=True
Application.DisplayAlerts = True

End With

 

[Alex Blakenburg]

Can you be a bit more specific as to what's not working, its seems to be working fine for me.

Do you perhaps have some shrapnel on your spreadsheat that is causing CountA to return a value on what you think is a blank row ?

20210313 Delete Blank Rows from Selection not working.xlsm
	A	B	C	D	E
1	Heading
2	aaa
3	aaa
4
5			bb
6	aaa
7	aaa
8	aaa
9
10	aaa
11	aaa
12	aaa
13	aaa
14	aaa
15
Test data

 

[visualnotsobasic]

Hey Alex, appreciate you taking the time to go through this with me. I'll try to explain the issue as best as I can. I'm trying to automate a process in which I take an excel template that has 20,000+ rows of equations and save it into a csv. The file that populates the template can vary anywhere from 10k-20k lines depending on the day. Then the eventual goal is to automatically drop the csv into accounting software that I utilize at work. The problem that I'm running into is that the code for the most part works as intended, however, when I save the workbook as a csv I need it to delete any blank rows that do not carry data. If my excel template has 10,000 lines of actual data, I need the csv to trim any blank rows below that so it only shows 10,000 lines of data with no blank rows below it. Right now, because of the 20,000+ rows of equations on the original template file, the csv will carry over the 10,000 lines of data but will also have 10,000 lines of blank rows below it. The accounting software the I use reads these empty rows as data and will error out, so I need to find a way to remove them entirely. Right now with my manual process, I go into the csv file and select the blank rows and delete them. I need to find a way to do this effectively with my vba code.

 

[Alex Blakenburg]

See if this works for you.

It contains two macros, your one slightly modified and a ResetLastCell one which is run by the Call ResetLastCell line that I have added to your macro.

I have left in your in your delete lines loop (slightly modified) but if the blank lines where only ever on the bottom, you don't need them.

Sub CreateCSVFile()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook
    Dim LastRowIndex As Integer
    Dim RowIndex As Integer
    Dim UsedRng As Range
    Dim TempSht As Worksheet
    Dim TempUsedRng As Range
    
    Set CurrentWB = ActiveWorkbook
    Set UsedRng = ActiveSheet.UsedRange
    ActiveWorkbook.ActiveSheet.UsedRange.Copy
    LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
    Application.ScreenUpdating = False
    
    Set TempWB = Application.Workbooks.Add(1)
    Set TempSht = ActiveSheet
    
    With TempSht.Range("A1")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
    End With
    
    On Error Resume Next
    Call ResetLastCell
    On Error GoTo 0
    
    Set TempUsedRng = TempSht.UsedRange
    
    'Delete blank rows in CSV'
    Dim i As Long
       
    With Application
        .Calculation = xlCalculationManual
        For i = TempUsedRng.Rows.Count To 1 Step -1
            If WorksheetFunction.CountA(TempUsedRng.Rows(i)) = 0 Then
                TempUsedRng.Rows(i).EntireRow.Delete
            End If
        Next i
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .CutCopyMode = False
        
        TempSht.Rows([1]).EntireRow.Delete
        
        ''Save CSV'
        MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
        
        .DisplayAlerts = False
        TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
        TempWB.Close SaveChanges:=True
        
        .DisplayAlerts = True
    
    End With

End Sub


Sub ResetLastCell()
  
    Dim lLastRow As Long, lLastColumn As Long
    Dim lRealLastRow As Long, lRealLastColumn As Long
    
    ' Find last row,column based on special cells method
    
    With Range("A1").SpecialCells(xlCellTypeLastCell)
        lLastRow = .Row
        lLastColumn = .Column
    End With
    
    ' Find backwards from A1 the last non-blank row
    lRealLastRow = Cells.Find("*", Range("A1"), xlFormulas, , _
        xlByRows, xlPrevious).Row
    
    ' Find backwards from A1 the last non-blank column
    lRealLastColumn = Cells.Find("*", Range("A1"), xlFormulas, , _
        xlByColumns, xlPrevious).Column
        
    'Delete from the row after the real last row to the last row
    'per special cells method
    If lRealLastRow < lLastRow Then
        Range(Cells(lRealLastRow + 1, 1), Cells(lLastRow, 1)).EntireRow.Delete
    End If
    
    'Delete from the column after the real last column to
    'the last column per special cells method
    If lRealLastColumn < lLastColumn Then
        Range(Cells(1, lRealLastColumn + 1), Cells(1, lLastColumn)).EntireColumn.Delete
    End If
    
    ActiveSheet.UsedRange  'Resets last cell
    
End Sub

 

[visualnotsobasic]

See if this works for you.

It contains two macros, your one slightly modified and a ResetLastCell one which is run by the Call ResetLastCell line that I have added to your macro.

I have left in your in your delete lines loop (slightly modified) but if the blank lines where only ever on the bottom, you don't need them.

Sub CreateCSVFile()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook
    Dim LastRowIndex As Integer
    Dim RowIndex As Integer
    Dim UsedRng As Range
    Dim TempSht As Worksheet
    Dim TempUsedRng As Range
   
    Set CurrentWB = ActiveWorkbook
    Set UsedRng = ActiveSheet.UsedRange
    ActiveWorkbook.ActiveSheet.UsedRange.Copy
    LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
    Application.ScreenUpdating = False
   
    Set TempWB = Application.Workbooks.Add(1)
    Set TempSht = ActiveSheet
   
    With TempSht.Range("A1")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
    End With
   
    On Error Resume Next
    Call ResetLastCell
    On Error GoTo 0
   
    Set TempUsedRng = TempSht.UsedRange
   
    'Delete blank rows in CSV'
    Dim i As Long
      
    With Application
        .Calculation = xlCalculationManual
        For i = TempUsedRng.Rows.Count To 1 Step -1
            If WorksheetFunction.CountA(TempUsedRng.Rows(i)) = 0 Then
                TempUsedRng.Rows(i).EntireRow.Delete
            End If
        Next i
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .CutCopyMode = False
       
        TempSht.Rows([1]).EntireRow.Delete
       
        ''Save CSV'
        MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
       
        .DisplayAlerts = False
        TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
        TempWB.Close SaveChanges:=True
       
        .DisplayAlerts = True
   
    End With

End Sub


Sub ResetLastCell()
 
    Dim lLastRow As Long, lLastColumn As Long
    Dim lRealLastRow As Long, lRealLastColumn As Long
   
    ' Find last row,column based on special cells method
   
    With Range("A1").SpecialCells(xlCellTypeLastCell)
        lLastRow = .Row
        lLastColumn = .Column
    End With
   
    ' Find backwards from A1 the last non-blank row
    lRealLastRow = Cells.Find("*", Range("A1"), xlFormulas, , _
        xlByRows, xlPrevious).Row
   
    ' Find backwards from A1 the last non-blank column
    lRealLastColumn = Cells.Find("*", Range("A1"), xlFormulas, , _
        xlByColumns, xlPrevious).Column
       
    'Delete from the row after the real last row to the last row
    'per special cells method
    If lRealLastRow < lLastRow Then
        Range(Cells(lRealLastRow + 1, 1), Cells(lLastRow, 1)).EntireRow.Delete
    End If
   
    'Delete from the column after the real last column to
    'the last column per special cells method
    If lRealLastColumn < lLastColumn Then
        Range(Cells(1, lRealLastColumn + 1), Cells(1, lLastColumn)).EntireColumn.Delete
    End If
   
    ActiveSheet.UsedRange  'Resets last cell
   
End Sub

You are an absolute saint! This worked like a charm. I cannot thank you enough for taking the time to fix my code for me, I've definitely learned a few new things looking at what you've written. Thank you so much!

 

[Alex Blakenburg]

It's a pleasure, happy to help.