Delete rows/columns across worksheets

[jrags01]

Hello Leith,

I'm also fairly new to VBA programming, but I'm attempting to create a similar solution that will delete blank columns across all worksheets building on what you provided to ncalsurfer. Obviously this is more difficult than I expected. Here's what I've got so far:

Sub Remove_Blanks_ALL_Sheets()
'
' Remove_Blank_Columns Macro
' Macro to remove blank columns in all sheets
'
' Keyboard Shortcut: Ctrl+r
'
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    ws.Cells.Select
    ws.Selection.SpecialCells(xlCellTypeBlanks).Select
    ws.Select.EntireColumn.Delete
Next ws
End Sub

Your assistance would be greatly appreciated. I'm using Excel 2007, but also have access to Excel 2010 if needed.

[Leith Ross]

Hello jrags01,

Welcome to the Forum!

As a new member, please read the Forum's Rules for posting when you have time. Forum Rules

Do any of the worksheets have merged cells?

[jrags01]

Hi Leith,

No merged cells.

[Leith Ross]

Hello jrags01,

Sorry to be picky, do you want to delete columns that might have cells with just spaces in them?

[jrags01]

Hi Leith,

My source data should not have any spaces in the cells as it has come from GIS. So I would like to delete all columns that don't have any data below the header row. If there is no data, delete the entire column.

[Leith Ross]

Hello jrags01,

This will start with cell "A1" on the ActiveSheet. You can change this to were you data starts. The macro will find the last row and column with data or a formula in it. The first row of the range is assumed to be the header row. All columns that are empty within the range are deleted.

Sub DeleteEmptyColumns()

    Dim c           As Long
    Dim LastCol     As Variant
    Dim LastRow     As Variant
    Dim Rng         As Range
    
        Set Rng = Range("A1")
        
        LastCol = Cells.Find("*", , xlFormulas, xlWhole, xlByColumns, xlPrevious, False, False, False).Column
        LastRow = Cells.Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious, False, False, False).row
        
        Set Rng = Rng.Resize(LastRow - Rng.row + 1, LastCol - Rng.Column + 1)
        Set Rng = Intersect(Rng, Rng.Offset(1, 0))
        
        For c = Rng.Columns.Count To 1 Step -1
            If Application.CountA(Rng.Columns(c)) = 0 Then
                Rng.Columns(c).EntireColumn.Delete
            End If
        Next c
        
End Sub

[jrags01]

Hi Leith,

That has worked brilliantly on a sheet by sheet basis so thanks for that. I wonder if there's a way to take it one step further and have it loop through all the sheets in the workbook and remove the empty columns, such that the macro would only have to be run once per file?

Thanks again,