Need VBA code to remove extra spaces between rows

Joined
Jan 11, 2024
Messages
19
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
I want to remove the extra spaces between rows in all the sheets of entire workbook. Some rows have extra spaces. Is there any vba macro for that?
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
This is based on Column "A"

VBA Code:
Sub RemoveBlank()
    For Each sh In Worksheets
        lr = sh.Range("A" & Rows.Count).End(xlUp).Row
        For i = lr To 2 Step -1
            If sh.Range("A" & i - 1).Value = "" Then sh.Range("A" & i - 1).EntireRow.Delete
        Next i
    Next sh
End Sub
 
Upvote 0
Could you provide a sample of your data using the XL2BB add in, or alternatively share your (desensitised) file via Google Drive, Dropbox or similar file sharing platform?
 
Upvote 0
This is based on Column "A"

VBA Code:
Sub RemoveBlank()
    For Each sh In Worksheets
        lr = sh.Range("A" & Rows.Count).End(xlUp).Row
        For i = lr To 2 Step -1
            If sh.Range("A" & i - 1).Value = "" Then sh.Range("A" & i - 1).EntireRow.Delete
        Next i
    Next sh
End Sub
Please note that rows are not extra instead there is extra space in some of the rows of the worksheet and same with whole workbook
 
Upvote 0
Try this (it checks all cells in each worksheet to make sure that data doesn't get deleted because A is blank):
VBA Code:
' Collapse the used range all spreadsheets in a worksbook by eliminating blanks rows.
Sub DeleteBlankRows()
    Const cstrTitle As String = "DeleteBlankRows"
    Dim strErrMsg As String
    Dim lngRowTop As Long
    Dim lngRowBtm As Long
    Dim lngColLft As Long
    Dim lngColRyt As Long
    Dim lngRowCntr As Long
    Dim rngRow As Range
    Dim rngCell As Range
    Dim bolEmpty As Boolean
    Dim wksToUse As Worksheet
    Dim rngToUse As Range
    '
    On Error GoTo Err_Exit
    '
    For Each wksToUse In ThisWorkbook.Worksheets
        Set rngToUse = wksToUse.UsedRange
        '
        ' Get the boundaries of the range to use.
        lngRowTop = rngToUse.Cells(1).Row
        lngRowBtm = rngToUse.Cells(rngToUse.Cells.Count).Row
        lngColLft = rngToUse.Cells(1).Column
        lngColRyt = rngToUse.Cells(rngToUse.Cells.Count).Column
        '
        ' Check the rows.
        lngRowCntr = lngRowTop
        While (lngRowCntr <= lngRowBtm)
            Set rngRow = wksToUse.Range(wksToUse.Cells(lngRowCntr, lngColLft), wksToUse.Cells(lngRowCntr, lngColRyt))
            bolEmpty = True
            For Each rngCell In rngRow
                If (Not Trim(Format(rngCell.Value)) = vbNullString) Then
                    bolEmpty = False
                    Exit For
                End If
            Next
            If bolEmpty Then
                If (lngRowTop <> lngRowBtm) Then
                    rngRow.Delete xlShiftUp
                    lngRowCntr = lngRowCntr - 1
                    lngRowBtm = lngRowBtm - 1
                End If
            End If
            lngRowCntr = lngRowCntr + 1
        Wend
    Next wksToUse
Housekeeping:
    Set rngToUse = Nothing
    Set rngRow = Nothing
    Set wksToUse = Nothing
    Exit Sub
Err_Exit:
    strErrMsg = Err.Number & ": " & Err.Description
    Err.Clear
    MsgBox strErrMsg, vbCritical + vbOKOnly, cstrTitle
    Resume Housekeeping
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,898
Messages
6,175,274
Members
452,628
Latest member
dd2

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
Back
Top