VBA debugging - cannot delete blank rows

visualnotsobasic

New Member
Joined
Mar 12, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
579
Office Version
  1. 365
Platform
  1. Windows
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
ABCDE
1Heading
2aaa
3aaa
4
5bb
6aaa
7aaa
8aaa
9
10aaa
11aaa
12aaa
13aaa
14aaa
15
Test data


1615594652530.png
 

visualnotsobasic

New Member
Joined
Mar 12, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Feb 23, 2021
Messages
579
Office Version
  1. 365
Platform
  1. Windows
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.


VBA Code:
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
 
Solution

visualnotsobasic

New Member
Joined
Mar 12, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
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.


VBA Code:
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!
 

Watch MrExcel Video

Forum statistics

Threads
1,129,685
Messages
5,637,809
Members
416,983
Latest member
LessThanAverageUser

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