delete columns that have an empty or blank cell

[abenitez77]

What is a faster way of deleting columns that are empty? I am looping thru the first 200 columns to see if each column has data in a specific row. If it is blank, then I want to delete that column. My way takes about 20-30 seconds to run.

lastCol = 0
For i = 1 To 200
If ActiveCell.Value = "" Then
ActiveCell.EntireColumn.Delete
Else
ActiveCell.Offset(0, 1).Select
lastCol = lastCol + 1
End If
Next i

 

[Joe4]

Try this:

Sub MyDeleteBlankColumns()

    Dim rw As Long
    Dim lc As Long
    
'   Get active row
    rw = ActiveCell.Row
    
'   Find last column in active row with data
    lc = Cells(rw, Columns.Count).End(xlToLeft).Column
    
'   Delete blank columns from row
    On Error Resume Next
    Range(Cells(rw, 1), Cells(rw, lc)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
    On Error GoTo 0
    
End Sub

You could combine some lines of code to make the code shorter (not any faster though), but I like to show it this way so it is easier to understand.

The reasons why your code is slower include:
1. Loops are notoriously slower
2. Physically selecting the cells slows it down (and it often is unnecessary to use "Select" or "Activate" statements)

 

[abenitez77]

The delete was much faster. Thanks Joe!

 

[Joe4]

You are welcome!