Macro to combine (sum) like items
Assuming if the cell in B is blank, the cell in A will be blank as well.
Sub Test()
Dim iLastrow As Long
Dim i As Long
iLastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastrow To 2 Step -1
If Cells(i,"B").Value = "" then
cells(i,"A").Formula = "=na()"
elseIf Cells(i, "B").Value = Cells(i - 1, "B").Value Then
Cells(i - 1, "A").Value = Cells(i - 1, "A").Value + _
Cells(i, "A").Value
Cells(i, "A").ClearContents
End If
Next i
On Error Resume Next
Range("A1:A" & iLastrow).SpecialCells(xlCellTypeBlanks).EntireRow .Delete
Columns(1).SpecialCells(xlFormulas,xlErrors).clear Contents
End Sub
--
Regards,
Tom Ogilvy
"Bob Phillips" wrote in message
...
Sub Test()
Dim iLastrow As Long
Dim i As Long
iLastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastrow To 2 Step -1
If Cells(i, "B").Value = Cells(i - 1, "B").Value Then
Cells(i - 1, "A").Value = Cells(i - 1, "A").Value + _
Cells(i, "A").Value
Cells(i, "A").ClearContents
End If
Next i
Range("A1:A" &
iLastrow).SpecialCells(xlCellTypeBlanks).EntireRow .Delete
End Sub
--
HTH
RP
(remove nothere from the email address if mailing direct)
"Scott Wagner" wrote in message
...
Looking to clean up product order list of items with a macro. Idea
would
be
that if the part number is the same sum all lines into one and then
delete
each line other than the sum line.
There are presorted by the part number so the like values would be in
adjacent rows.
Thanks so much!
Scott
Here is an example of what I have:
Qty Part #
4 SG400R
1 TK4V1200R
1 TK4V1200R
6 TNG3
8 TNG3
6 TNG3
2 SKLB36BC1200
1 SKLB36BC1200
1 TCAL125
12 TCAL125
Here is what I'd like to end up with:
Qty Part #
4 SG400R
2 TK4V1200R
20 TNG3
3 SKLB36BC1200
13 TCAL125
|