Delete columns with 0 value but I want to keep the header in row 1

[JeanBI]

I have a report that I have to publish every week. I also use MS Excel 2010.

How do you delete columns with a value of 0 starting in row 2, also starting from column N (or anything after column 14)?

My report has a header but it will constantly change and I will continue to add columns after column N.

This is a code I found but it needs to be modified. Can you help?


Here SubDeleteColumnsWithValueOfzero()
'Range("a2:u20").Select
Dim lColumn As Long
Dim iCntr As Long
lColumn = 21
For iCntr = lColumnTo 1 Step -1
'starts on row 2
If Cells(2, iCntr) =0 Then
Columns(iCntr).DELETE
End If
Next

End Sub

 

[JackDanIce]

Try:

Sub DeleteRowsWithZero()
    
    Dim LC  As Long
    Dim LR  As Long
    
    Application.ScreenUpdating = False
    
    LC = Cells(1, Columns.Count).End(xlToLeft).Column
    LR = Cells.find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious).row
    
    With Cells(2, 1).Resize(LR - 1, LC)
        .Replace 0, vbNullString, xlByColumns
        .SpecialCells(xlCellTypeBlanks).ClearContents
    End With
    
    Application.ScreenUpdating = True


End sub

 

[MrKowz]

I have a report that I have to publish every week. I also use MS Excel 2010.

How do you delete columns with a value of 0 starting in row 2, also starting from column N (or anything after column 14)?

My report has a header but it will constantly change and I will continue to add columns after column N.

This is a code I found but it needs to be modified. Can you help?


Here SubDeleteColumnsWithValueOfzero()
'Range("a2:u20").Select
Dim lColumn As Long
Dim iCntr As Long
lColumn = 21
For iCntr = lColumnTo 1 Step -1
'starts on row 2
If Cells(2, iCntr) =0 Then
Columns(iCntr).DELETE
End If
Next

End Sub

It sounds like you're wanting to clear the data from row 2 to the bottom of the sheet where row 2 = 0 in each column, beginning with column N. Give this a shot:

Public Sub ClearZeroColumns()
Dim i       As Long, _
    LC      As Long
   
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
   
LC = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 14 To LC
    If Cells(2, i).Value = 0 Then
        Range(Cells(2, i), Cells(Rows.Count, i)).ClearContents
    End If
Next i

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

 

[JackDanIce]

Forgot about column "N", suggested code amended to:

Sub DeleteRowsWithZero()
    
    Dim LC      As Long
    Dim LR      As Long
    Dim arr()   As Variant
    
    Application.ScreenUpdating = False
    
    LC = Cells(1, Columns.Count).End(xlToLeft).Column
    LC = Application.Min(LC, Range("N1").Column)
    
    LR = Cells.find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious).row
    
    With Cells(2, 1).Resize(LR - 1, LC)
        .Replace 0, vbNullString, xlByRows
        arr = .Offset(-1).Resize(1).Value
        .SpecialCells(xlCellTypeBlanks).EntireColumn.ClearContents
        .Offset(-1).Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    End With
    Erase arr
    
    Application.ScreenUpdating = True


End Sub

 

[JeanBI]

Hi there... this works but instead of clearing contents, I would like to delete the entire column. Is that possible? You can delete the header row also just as long as there is a zero value in row 2. Thanks,



Public Sub ClearZeroColumns()
Dim i As Long, _
LC As Long

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

LC = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 14 To LC
If Cells(2, i).Value = 0 Then
Range(Cells(2, i), Cells(Rows.Count, i)).ClearContents
End If
Next i

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub

 

[MrKowz]

Hi there... this works but instead of clearing contents, I would like to delete the entire column. Is that possible? You can delete the header row also just as long as there is a zero value in row 2. Thanks,

This should do what you're looking to accomplish:

Public Sub ClearZeroColumns()
Dim i       As Long, _
    LC      As Long
   
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
   
LC = Cells(1, Columns.Count).End(xlToLeft).Column
For i = LC To 14 Step -1
    If Cells(2, i).Value = 0 Then
        Cells(2, i).EntireColumn.Delete shift:=xlLeft
    End If
Next i

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

 

[JeanBI]

MrKowz... it worked, this is perfect. Saves a lot of time in formatting. Thank you!