|
Macro to combine (sum) like items
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 |
Macro to combine (sum) like items
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 |
Macro to combine (sum) like items
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? "Bob Phillips" wrote: 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 |
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 |
Macro to combine (sum) like items
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" wrote: 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 |
Macro to combine (sum) like items
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 -- Regards, Tom Ogilvy "Scott Wagner" wrote in message ... 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" wrote: 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 |
Macro to combine (sum) like items
Works prefectly!
Thank you so much! Scott "Tom Ogilvy" wrote: 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 -- Regards, Tom Ogilvy "Scott Wagner" wrote in message ... 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" wrote: 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 |
| All times are GMT +1. The time now is 08:05 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com