Delete entire column if all cells in a certain range are empty

**Andula** · 10-26-2011, 05:06 AM

I'm not experienced with macros but I'm trying to automate a spreadsheet formatting process to save me a lot of time. One of the functions I need to perform is to delete columns where all cells within a certain range are empty. So, in columns C to FZ, if cells 3 to 1000 are all empty, delete the entire column.

Can anyone help me with this?

**Domski** · 10-26-2011, 05:49 AM

Hi,

Try this:

Sub test()
    Dim lngColLoop As Long
    For lngColLoop = 182 To 3 Step -1
        If Application.CountA(Cells(3, lngColLoop).Resize(998, 1)) = 0 Then
            Columns(lngColLoop).Delete
        End If
    Next lngColLoop
End Sub

Dom

**Richard Buttrey** · 10-26-2011, 05:51 AM

Hi,

Create a helper row 1 and use =IF(SUM(C4:C1001)=0,"delete","keep")

Now use a macro along the lines of

Sub DeleteColumns()
    Dim x As Long
    For x = Range("G1:L1").Cells.Count To 1 Step -1
        If LCase(Range("G1:L1").Cells(1, x)) = "delete" Then Range("G1:L1").Cells(1, x).EntireColumn.Delete
    Next x

End Sub

Regards

**Andula** · 10-26-2011, 06:07 AM

Thanks Dom, that works nicely

**Richard Buttrey** · 10-26-2011, 06:33 AM

Originally Posted by Richard Buttrey

Hi,

Create a helper row 1 and use =IF(SUM(C4:C1001)=0,"delete","keep")

Now use a macro along the lines of

Sub DeleteColumns()
    Dim x As Long
    For x = Range("G1:L1").Cells.Count To 1 Step -1
        If LCase(Range("G1:L1").Cells(1, x)) = "delete" Then Range("G1:L1").Cells(1, x).EntireColumn.Delete
    Next x

End Sub

Regards

That formula should of course be put in C1 and copied across to FZ1 and the Range in the macro refer to C1:FZ1 and not my test range of G1:L1

Regards

**nilem** · 10-26-2011, 06:04 AM

another option:

Sub Andula() 
Dim i&, r As Range, rDel As Range

For i = 3 To 182    'columns C...FZ
    Set r = Cells(3, i).Resize(998)
    If r.Text = "" Then 'Note r.value=0 <> r.value=""
        If rDel Is Nothing Then Set rDel = Cells(3, i) Else Set rDel = Union(rDel, Cells(3, i))
    End If
Next i
If Not rDel Is Nothing Then rDel.EntireColumn.Delete
End Sub