Search code examples
excelvbaloopshide

VBA: Hiding Columns That Are Empty (=0)


I have created a macro (which works) that goes through all columns that i know i am using, checks to see if the sum of those columns is equal to zero or not, and if they are equal to zero then the macro will hide the columns individually (Please see my current macro below).

However, new columns can get added fairly regularly, so i was hoping someone could help create a loop that goes through all used columns instead rather than having to set each used column as a variable within the macro.

Sub RemoveEmptyColumns()

    Application.ScreenUpdating = False

    Dim column1 As Double, column2 As Double, column3 As Double
    Dim column4 As Double, column5 As Double, column6 As Double
    Dim column7 As Double, column8 As Double, column9 As Double
    Dim column10 As Double, column11 As Double, column12 As Double
    Dim column13 As Double, column14 As Double, column15 As Double
    Dim column16 As Double, column17 As Double, column18 As Double
    Dim column19 As Double, column20 As Double, column21 As Double
    Dim column22 As Double, column23 As Double, column24 As Double
    Dim column25 As Double, column26 As Double, column27 As Double
    Dim column28 As Double, column29 As Double, column30 As Double
    Dim column31 As Double, column32 As Double, column33 As Double
    Dim column34 As Double, column35 As Double, column36 As Double
    Dim column37 As Double
    
    column1 = Application.WorksheetFunction.Sum(Range("D4:D708"))
    column2 = Application.WorksheetFunction.Sum(Range("E4:E708"))
    column3 = Application.WorksheetFunction.Sum(Range("F4:F708"))
    column4 = Application.WorksheetFunction.Sum(Range("G4:G708"))
    column5 = Application.WorksheetFunction.Sum(Range("H4:H708"))
    column6 = Application.WorksheetFunction.Sum(Range("I4:I708"))
    column7 = Application.WorksheetFunction.Sum(Range("J4:J708"))
    column8 = Application.WorksheetFunction.Sum(Range("K4:K708"))
    column9 = Application.WorksheetFunction.Sum(Range("L4:L708"))
    column10 = Application.WorksheetFunction.Sum(Range("M4:M708"))
    column11 = Application.WorksheetFunction.Sum(Range("N4:N708"))
    column12 = Application.WorksheetFunction.Sum(Range("O4:O708"))
    column13 = Application.WorksheetFunction.Sum(Range("P4:P708"))
    column14 = Application.WorksheetFunction.Sum(Range("Q4:Q708"))
    column15 = Application.WorksheetFunction.Sum(Range("R4:R708"))
    column16 = Application.WorksheetFunction.Sum(Range("S4:S708"))
    column17 = Application.WorksheetFunction.Sum(Range("T4:T708"))
    column18 = Application.WorksheetFunction.Sum(Range("U4:U708"))
    column19 = Application.WorksheetFunction.Sum(Range("V4:V708"))
    column20 = Application.WorksheetFunction.Sum(Range("W4:W708"))
    column21 = Application.WorksheetFunction.Sum(Range("X4:X708"))
    column22 = Application.WorksheetFunction.Sum(Range("Y4:Y708"))
    column23 = Application.WorksheetFunction.Sum(Range("Z4:Z708"))
    column24 = Application.WorksheetFunction.Sum(Range("AA4:AA708"))
    column25 = Application.WorksheetFunction.Sum(Range("AB4:AB708"))
    column26 = Application.WorksheetFunction.Sum(Range("AC4:AC708"))
    column27 = Application.WorksheetFunction.Sum(Range("AD4:AD708"))
    column28 = Application.WorksheetFunction.Sum(Range("AE4:AE708"))
    column29 = Application.WorksheetFunction.Sum(Range("AF4:AF708"))
    column30 = Application.WorksheetFunction.Sum(Range("AG4:AG708"))
    column31 = Application.WorksheetFunction.Sum(Range("AH4:AH708"))
    column32 = Application.WorksheetFunction.Sum(Range("AI4:AI708"))
    column33 = Application.WorksheetFunction.Sum(Range("AJ4:AJ708"))
    column34 = Application.WorksheetFunction.Sum(Range("AK4:AK708"))
    column35 = Application.WorksheetFunction.Sum(Range("AL4:AL708"))
    column36 = Application.WorksheetFunction.Sum(Range("AM4:AM708"))
    column37 = Application.WorksheetFunction.Sum(Range("AN4:AN708"))
 
    If column1 = 0 Then
    Columns("D:D").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column2 = 0 Then
    Columns("E:E").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column3 = 0 Then
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column4 = 0 Then
    Columns("G:G").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column5 = 0 Then
    Columns("H:H").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column6 = 0 Then
    Columns("I:I").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column7 = 0 Then
    Columns("J:J").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column8 = 0 Then
    Columns("K:K").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column9 = 0 Then
    Columns("L:L").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column10 = 0 Then
    Columns("M:M").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column11 = 0 Then
    Columns("N:N").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column12 = 0 Then
    Columns("O:O").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column13 = 0 Then
    Columns("P:P").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column14 = 0 Then
    Columns("Q:Q").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column15 = 0 Then
    Columns("R:R").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column16 = 0 Then
    Columns("S:S").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column17 = 0 Then
    Columns("T:T").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column18 = 0 Then
    Columns("U:U").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column19 = 0 Then
    Columns("V:V").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column20 = 0 Then
    Columns("W:W").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column21 = 0 Then
    Columns("X:X").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column22 = 0 Then
    Columns("Y:Y").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column23 = 0 Then
    Columns("Z:Z").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column24 = 0 Then
    Columns("AA:AA").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column25 = 0 Then
    Columns("AB:AB").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column26 = 0 Then
    Columns("AC:AC").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column27 = 0 Then
    Columns("AD:AD").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column28 = 0 Then
    Columns("AE:AE").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column29 = 0 Then
    Columns("AF:AF").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column30 = 0 Then
    Columns("AG:AG").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column31 = 0 Then
    Columns("AH:AH").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column32 = 0 Then
    Columns("AI:AI").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column33 = 0 Then
    Columns("AJ:AJ").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column34 = 0 Then
    Columns("AK:AK").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column35 = 0 Then
    Columns("AL:AL").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column36 = 0 Then
    Columns("AM:AM").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column37 = 0 Then
    Columns("AN:AN").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    Application.ScreenUpdating = True
    
End Sub

Any help would be much appreciated.

Thanks!


Solution

  • You can shorten your code thus with a loop.

    You needn't hard-code the last row either if it is likely to vary.

    And no need to select.

    Sub x()
    
    Dim n As Long, c As Long
    
    n = Cells(4, Columns.Count).End(xlToLeft).Column 'find last column in row 4
    
    For c = 1 To n 'loop through each column
        If Application.WorksheetFunction.Sum(Range(Cells(4, c), Cells(708, c))) = 0 Then
            Cells(4, c).EntireColumn.Hidden = True
        End If
    Next c
    
    End Sub