Extend to more columns

[Guest]

Hi, the following code sums Column B,
However I need to do the same for each column, B-I.
Then, If a sum = 0 I need to delete that column,
the following code requires a few extra lines, help is much appreciated

Sub intq()

Dim intNumRows As Integer, c As Variant, lngCellTotal As Long


intNumRows = Cells(50, "h").End(xlUp).Row
With Range("h" & intNumRows + 1)
' .Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium

End With
For Each c In Range("h1", "h" & intNumRows)
lngCellTotal = lngCellTotal + c.Value
Next
Range("h" & intNumRows + 1) = lngCellTotal
* If lngCellTotal = 0 Then
* Range("IngCellTotal").Columns.Delete

* End If

End Sub

 

[Nick Hodge]

Teresa

I believe the code below does what you want

Sub DeleteZeroCols()
Dim x As Integer
For x = 9 To 2 Step -1
If Application.WorksheetFunction.Sum(Columns(x).EntireColumn) = 0 Then
Columns(x).EntireColumn.Delete
End If
Next x
End Sub

--
HTH
Nick Hodge
Microsoft MVP - Excel
Southampton, England
(e-mail address removed)

 

[Bob Phillips]

Sub intq()

Dim intNumRows As Integer, c As Range, lngCellTotal As Long
Dim i As Long

For i = 9 To 2 Step -1 'I to B
intNumRows = Cells(50, i).End(xlUp).Row
lngCellTotal = 0
For Each c In Range(Cells(1, i), Cells(intNumRows, i))
lngCellTotal = lngCellTotal + c.Value
Next
If lngCellTotal = 0 Then
Columns(i).EntireColumn.Delete
Else
With Cells("h" & intNumRows + 1)
' .Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Value = lngCellTotal
End With
End If
Next i

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)