Extend to more columns
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)
"teresa" wrote in message
...
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
|