Saving Excel data as csv with VBA - removing blank rows at end of file to save

Question

I am creating a set of csv files in VBA.

My script is creating the data set I need, but the number of rows differs in multiple iterations of the loop. For instance,

Answer 1

Excel saves the UsedRange. In order to truncate the UsedRange, you need to delete whole rows and save the file.

If that's not an option, insert a new worksheet, copy the prepared data to it (thus leaving its UsedRange matching actual data), use Worksheet.SaveAs (as opposed to Workbook.SaveAs) and delete the worksheet.

Although the actual problem here is why your UsedRange gets that big in the first place.

Answer 2

You can get the UsedRange to recalculate itself without deleting columns and rows with a simple

ActiveSheet.UsedRange

Alternatively you can automate the manual removal of the "false" usedrange by deleting the areas below the last used cell with code such as DRJ's VBAexpress article, or by using an addin such as ASAP Utilities

The function from DRJ's article is;

Option Explicit 

Sub ExcelDiet() 

Dim j               As Long 
Dim k               As Long 
Dim LastRow         As Long 
Dim LastCol         As Long 
Dim ColFormula      As Range 
Dim RowFormula      As Range 
Dim ColValue        As Range 
Dim RowValue        As Range 
Dim Shp             As Shape 
Dim ws              As Worksheet 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

On Error Resume Next 

For Each ws In Worksheets 
    With ws 
         'Find the last used cell with a formula and value
         'Search by Columns and Rows
        On Error Resume Next 
        Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _ 
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious) 
        Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _ 
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious) 
        Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _ 
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious) 
        Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _ 
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious) 
        On Error GoTo 0 

         'Determine the last column
        If ColFormula Is Nothing Then 
            LastCol = 0 
        Else 
            LastCol = ColFormula.Column 
        End If 
        If Not ColValue Is Nothing Then 
            LastCol = Application.WorksheetFunction.Max(LastCol, ColValue.Column) 
        End If 

         'Determine the last row
        If RowFormula Is Nothing Then 
            LastRow = 0 
        Else 
            LastRow = RowFormula.Row 
        End If 
        If Not RowValue Is Nothing Then 
            LastRow = Application.WorksheetFunction.Max(LastRow, RowValue.Row) 
        End If 

         'Determine if any shapes are beyond the last row and last column
        For Each Shp In .Shapes 
            j = 0 
            k = 0 
            On Error Resume Next 
            j = Shp.TopLeftCell.Row 
            k = Shp.TopLeftCell.Column 
            On Error GoTo 0 
            If j > 0 And k > 0 Then 
                Do Until .Cells(j, k).Top > Shp.Top + Shp.Height 
                    j = j + 1 
                Loop 
                If j > LastRow Then 
                    LastRow = j 
                End If 
                Do Until .Cells(j, k).Left > Shp.Left + Shp.Width 
                    k = k + 1 
                Loop 
                If k > LastCol Then 
                    LastCol = k 
                End If 
            End If 
        Next 

        .Range(.Cells(1, LastCol + 1), .Cells(.Rows.Count, .Columns.Count)).EntireColumn.Delete 
        .Range("A" & LastRow + 1 & ":A" & .Rows.Count).EntireRow.Delete 
    End With 
Next 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 

End Sub