Take a look at Data|subtotals
(Since this is such a useful function, I'd try to accept the "wrong" column
stuff!)
--
Dave Peterson
ec3...@msn.com
Public Sub SubtotalIt()
Dim cell As Range
Application.DisplayAlerts = False
Cells.Subtotal GroupBy:=3, _
Function:=xlSum, _
TotalList:=Array(10), _
Replace:=True, _
PageBreaks:=False, _
SummaryBelowData:=True
Application.DisplayAlerts = True
For Each cell In Columns(3).Cells.SpecialCells( _
xlCellTypeConstants, xlTextValues)
If InStr(cell.Text, " Total") Then _
cell.Offset(0, 7).Cut cell.Offset(0, 11)
Next cell
End Sub
In article <084201c37097$32da5d50$a601...@phx.gbl>,
(watch for line wrap)
Dim Cell2Check
'holds the current total of the coulumn
Dim ColTotal As Single
Dim Col2Comp As Integer
Dim ValCol As Integer
Dim TotCol As Integer
Dim CompareColumn As String
Dim Numbers2AddCol As String
Dim Total2Column As String
' CHANGE THESE LETTERS TO
' YOUR COLUMNS
' can be upper or lower case
'==============================
CompareColumn = "C" ' 1300, 1310 ,etc
Numbers2Add = "J" ' numbers to add
Total2Column = "n" ' column to put total
'==============================
' Initialize variables
' convert to uppercase and subtract 64 to get column number
Col2Comp = Asc(UCase(CompareColumn)) - 64
' these two are relative positions to the activecell
(Col2Comp)
' and are GT so subtract to get offset
ValCol = Asc(UCase(Numbers2AddCol)) - 64 - Col2Comp
TotCol = Asc(UCase(Total2Column)) - 64 - Col2Comp
ColTotal = 0
' goto first cell
'ActiveSheet.Cells(Row2Start, Col2Comp).Select
'Get first value
Cell2Check = ActiveCell.Value
'get first number
'ColTotal = ActiveCell.Offset(0, ValCol).Value
Do While ActiveCell.Value <> ""
' if current cell value = saved value
Do While ActiveCell.Value = Cell2Check
' add current number to running total
ColTotal = ColTotal + ActiveCell.Offset(0,
ValCol).Value
' move down one row
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.EntireRow.Insert
' write total to cell
ActiveCell.Offset(0, TotCol).Value = ColTotal
' move down one row
ActiveCell.Offset(1, 0).Activate
'starting again so....
' get the new value of the cell to check
Cell2Check = ActiveCell.Value
'clear column total
ColTotal = 0
Loop
Yes, longer but more control....
HTH
Steve
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)
>.
>
Peter
>.
>
Peter
>.
>
Peter
>.
>