Supress Columns with zero values by using VBA

[Katrine1]

Hi,
Would appreciate some help with this error message received for "Suppressing zero value columns" in a spreadsheet. The VBA code is not made by me and I'm not familiar with using VBA coding, thus I'm completely blank on how to fix it.

Sub hide()
Application.ScreenUpdating = False


Dim oneColumn As Range




For Each oneColumn In ActiveSheet.UsedRange.Columns("B:ZZ")

oneColumn.Hidden = (Application.CountIf(oneColumn, 0) = Application.Count(oneColumn))



Next oneColumn






Set urng = ActiveWorkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeVisible)
If Not urng Is Nothing Then
s = Split(urng.Cells(1, 1).Address, "$")
LR = LRow(ActiveWorkbook.Sheets(1))
lc = LCol(ActiveWorkbook.Sheets(1))
icol = urng.Cells(1, 1).Column


' delete hidden colums
Set urng2 = ActiveWorkbook.Sheets(1).Range(Cells(s(2), 1), Cells(s(2), lc))
Set oVisible = urng2.SpecialCells(xlCellTypeVisible)
Set oHidden = urng2


oHidden.EntireColumn.Hidden = False
oVisible.EntireColumn.Hidden = True


Set oHidden = urng2.SpecialCells(xlCellTypeVisible)
oHidden.EntireColumn.Delete
oVisible.EntireColumn.Hidden = False


End If




Application.ScreenUpdating = True
End Sub


Function LRow(sh As Worksheet)
On Error Resume Next
LRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function




Function LCol(sh As Worksheet)
On Error Resume Next
LCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub Katrine1()
    Dim oneColumn As Range, Rng As Range
    Application.ScreenUpdating = False

    For Each oneColumn In ActiveSheet.UsedRange.Columns("B:ZZ")
        If Application.CountIf(oneColumn, 0) = Application.Count(oneColumn) Then
            If Rng Is Nothing Then Set Rng = oneColumn Else Set Rng = Union(Rng, oneColumn)
        End If
    Next oneColumn
    If Not Rng Is Nothing Then Rng.Delete
End Sub