Macro to combine (sum) like items

[Guest]

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

 

[Bob Phillips]

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)

 

[Guest]

Thanks Bob, only one small issue. Can you tell me how to have this exclude
lines that have a blank value in the B column cells?

 

[Tom Ogilvy]

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).clearContents
End Sub

 

[Guest]

With the example I gave, you are correct Tom. That was my mistake. I
attempted to simplfy the example, net complicated it.

The actual data looks more like this:
Mark Qty Ordered Desctiption 1 Part #
N5 1 Panelboard, Type AE (101)
N5 1 Panel Back Box
N5 1 Panel Trim
4 Circuit Breaker Enclosure 134 SG400R
1 Circuit Breaker Enclosure 134 TK4V1200R
1 Circuit Breaker Enclosure 134 TK4V1200R
6 Load Center, 1 Ph (137A) TNG3
8 Load Center, 1 Ph (137A) TNG3
6 Load Center, 1 Ph (137A) TNG3
1 Spectra MCB (135S) TCAL125
12 Spectra MCB (135S) TCAL125

The panel items are custom built and have no actual part #, they are
designated by a mark instead (which doesn't need to be combined at all).

The other examples do have real part numbers and I'd like to combine those.
The macro you included I adapted as follows to bring into consideration
columns B and D in place of A and B. When I run this now, nothing changes.
What am I missing, I am not strong with VBA by any means. You will notice
that I replaced the portion of the IF statement, #NA with Cells(i, "B"). My
thinking was that IF not NULL then =B Will that work?

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, "D").Value = "" Then
Cells(i, "B").Formula = Cells(i, "B")
ElseIf Cells(i, "D").Value = Cells(i - 1, "D").Value Then
Cells(i - 1, "B").Value = Cells(i - 1, "B").Value + _
Cells(i, "B").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).ClearContents
End Sub


Thank you sir!

 

[Tom Ogilvy]

Possibly like this:

Sub Test()
Dim iLastrow As Long
Dim i As Long

iLastrow = Cells(Rows.Count, "D").End(xlUp).Row
For i = iLastrow To 2 Step -1
If Cells(i, "D").Value <> "" Then
If Cells(i, "D").Value = Cells(i - 1, "D").Value Then
Cells(i - 1, "B").Value = Cells(i - 1, "B").Value + _
Cells(i, "B").Value
Rows(i).Delete
End If
End If
Next i
End Sub

 

[Guest]

Works prefectly!

Thank you so much!

Scott

Possibly like this:

Sub Test()
Dim iLastrow As Long
Dim i As Long

iLastrow = Cells(Rows.Count, "D").End(xlUp).Row
For i = iLastrow To 2 Step -1
If Cells(i, "D").Value <> "" Then
If Cells(i, "D").Value = Cells(i - 1, "D").Value Then
Cells(i - 1, "B").Value = Cells(i - 1, "B").Value + _
Cells(i, "B").Value
Rows(i).Delete
End If
End If
Next i
End Sub