Delete blank rows and columns in Excel through macros

[M1991]

Hi Excel solvers. Please help me as I would like the macro to figure if there is any blank rows or columns and delete them. How could I write this in macro? Thank you.

 

[kweaver]

Welcome to Mr. Excel.

I use (free) ASAP Utilities which has a routine for this.

Alternatively, here's a fairly comprehensive VBA approach:

Sub RemoveBlankRowsColumns()
'PURPOSE: Remove blank rows or columns contained in the spreadsheets UsedRange
'SOURCE: www.TheSpreadsheetGuru.com

Dim rng As Range
Dim rngDelete As Range
Dim RowCount As Long, ColCount As Long
Dim EmptyTest As Boolean, StopAtData As Boolean
Dim RowDeleteCount As Long, ColDeleteCount As Long
Dim x As Long
Dim UserAnswer As Variant

'Analyze the UsedRange
Set rng = ActiveSheet.UsedRange
  rng.Select

  RowCount = rng.Rows.Count
  ColCount = rng.Columns.Count
  DeleteCount = 0

'Determine which cells to delete
  UserAnswer = MsgBox("Do you want to delete only the empty rows & columns " & _
    "outside of your data?" & vbNewLine & vbNewLine & "Current Used Range is " & rng.Address, vbYesNoCancel)

If UserAnswer = vbCancel Then
Exit Sub
ElseIf UserAnswer = vbYes Then
StopAtData = True
End If

'Optimize Code
Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'Loop Through Rows & Accumulate Rows to Delete
For x = RowCount To 1 Step -1
'Is Row Not Empty?
If Application.WorksheetFunction.CountA(rng.Rows(x)) <> 0 Then
If StopAtData = True Then Exit For
Else
If rngDelete Is Nothing Then Set rngDelete = rng.Rows(x)
Set rngDelete = Union(rngDelete, rng.Rows(x))
        RowDeleteCount = RowDeleteCount + 1
End If
Next x

'Delete Rows (if necessary)
If Not rngDelete Is Nothing Then
    rngDelete.EntireRow.Delete Shift:=xlUp
Set rngDelete = Nothing
End If
 
'Loop Through Columns & Accumulate Columns to Delete
For x = ColCount To 1 Step -1
'Is Column Not Empty?
If Application.WorksheetFunction.CountA(rng.Columns(x)) <> 0 Then
If StopAtData = True Then Exit For
Else
If rngDelete Is Nothing Then Set rngDelete = rng.Columns(x)
Set rngDelete = Union(rngDelete, rng.Columns(x))
        ColDeleteCount = ColDeleteCount + 1
End If
Next x

'Delete Columns (if necessary)
If Not rngDelete Is Nothing Then
  rngDelete.Select
    rngDelete.EntireColumn.Delete
End If

'Refresh UsedRange (if necessary)
If RowDeleteCount + ColDeleteCount > 0 Then
    ActiveSheet.UsedRange
Else
    MsgBox "No blank rows or columns were found!", vbInformation, "No Blanks Found"
End If

ExitMacro:
  Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
  rng.Cells(1, 1).Select
 
End Sub

 

[Joe4]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Delete blank rows and columns in Excel through macros - OzGrid Free Excel/VBA Help Forum
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.