View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Scott Wagner Scott Wagner is offline
external usenet poster
 
Posts: 82
Default 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