How do I find duplicate rows, add quantity field & retain one reco

[Pearl]

I have a list of data and I need to write a macro that would find rows which
contained duplicate information (except for the cells containing the
different quantities), combine them into one row entry with the total
quantity for all the duplicate rows and keep only one record. The list does
contain blank rows and can be quite lengthy with numerous variations of
information which is usually never the same from list to list.

What I have is:
A B1 6 53.25 37.25

B B1 8 34.00 45.75
A B1p 2 53.25 37.25
C GL1 20 34.00 45.75

A B1 14 53.25 37.25


A B1p 7 53.25 37.25
A GL1 10 34.00 45.75
B B1 100 34 45.75
A B1P 18 53.25 37.25

C GL1 5 34.00 45.75
B MP1 10 12.5 18.00

What I would like to have is:
A B1 20 53.25 37.25
A B1p 27 53.25 37.25
A GL1 10 34.00 45.75
B B1 108 34.00 45.75
B MP1 10 12.5 18.00
C GL1 25 34.00 45.75

How do I accomplish this with a macro?

 

[Rick Hansen]

I have a list of data and I need to write a macro that would find rows which
contained duplicate information (except for the cells containing the
different quantities), combine them into one row entry with the total
quantity for all the duplicate rows and keep only one record. The list does
contain blank rows and can be quite lengthy with numerous variations of
information which is usually never the same from list to list.

What I have is:
A B1 6 53.25 37.25

B B1 8 34.00 45.75
A B1p 2 53.25 37.25
C GL1 20 34.00 45.75

A B1 14 53.25 37.25


A B1p 7 53.25 37.25
A GL1 10 34.00 45.75
B B1 100 34 45.75
A B1P 18 53.25 37.25

C GL1 5 34.00 45.75
B MP1 10 12.5 18.00

What I would like to have is:
A B1 20 53.25 37.25
A B1p 27 53.25 37.25
A GL1 10 34.00 45.75
B B1 108 34.00 45.75
B MP1 10 12.5 18.00
C GL1 25 34.00 45.75

How do I accomplish this with a macro?

 

[Rick Hansen]

Good Evening from the Land of Midnight Sun, Pearl.
Sorry about the first, try I clicked to Fast. Anyway, I believe I have
come up with macro solution for project. In a nut shell the code determines
range of the list. Once the ranger has determine lastrow(lrow) , lastcol
(lcol), then range object is set, ie (xRng). Then the Range(xRng) is sorted
with key on columns A & B, thus alphabetical sorted by row. (Note: All Blank
rows are sort towards the bottom of the range, all data is towards the top
of the range). So now all Like data is grouped together. Now with simple
"for loop" and compare routine you add the qty's for all like items. Then
single like item is copied to NewData array with complete qty. Once the For
Loop is complete. The NewData() array is copy to Worksheet "Sheet2",
with topleft cell being at "A3". This down and dirt explaination. If have
questions, please post me post...

enjoy, Rick (Fairbanks, Alaska)




Option Explicit

Sub combineData()

Dim xRng As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lRow As Long
Dim lCol As Integer, iRow As Integer
Dim x As Integer, cnt As Integer
Dim hold As Variant, NewData() As Variant
Dim holdRet As Variant
Dim strhold As String

Set ws1 = ActiveSheet '' I used sheet1
Set ws2 = Worksheets("Sheet2")

Application.ScreenUpdating = False

'' find last item in list row location
lRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
'' find last column location
lCol = ws1.Range("A3").End(xlToRight).Column

'' now set range object
Set xRng = ws1.Range("A3:" & Chr(64 + lCol) & lRow)
holdRet = xRng ''save old list range

'' sort range by col A, & col B
xRng.Sort key1:=ws1.Range("A3"), order1:=xlAscending,
key2:=ws1.Range("B3"), _
order2:=xlAscending, header:=xlGuess, Orientation:=xlSortColumns

'' find last row in xrng range.(Note: all blank rows are bottom of range
xrng)
lRow = xRng.End(xlDown).Row
'' set new diminsion for Newdata array
ReDim NewData(1 To lRow, 1 To lCol)

'' copy xrng into hold variant variable, now hold is variant array.
hold = xRng

iRow = 1 '' row location, in hold() array
cnt = 1 '' row location for NewData() array

Do
'' concatenate to make string
strhold = hold(iRow, 1) & hold(iRow, 2)
'' copy data from hold array to newdata arrray
For x = 1 To lCol
NewData(cnt, x) = hold(iRow, x)
Next x

NewData(cnt, 3) = 0
Do
'' calc the qty's of each like hold names
NewData(cnt, 3) = NewData(cnt, 3) + hold(iRow, 3)
'' point next row in hold()
iRow = iRow + 1
'' don't break hold() boundaries, loop if compare string = to next
row
Loop While (i < UBound(hold, 1) And strhold = hold(iRow, 1) &
hold(iRow, 2))
'' point to next row in NewData()
cnt = cnt + 1
'' don't break hold() boundaries and don't process if next row is empty
Loop While (i < UBound(hold, 1) And hold(iRow, 1) <> "")

'' now find lastrow that was used in Newadata()
For x = LBound(NewData, 1) To UBound(NewData, 1)
If NewData(x, 1) = "" Then
Exit For
End If
Next x

xRng.Value = holdRet '' copy old stuff back
Set xRng = Nothing '' clear old range object
'' now set xrng with number rows in Newdata, number col's
Set xRng = ws2.Range("A3").Resize(x, lCol)
' now copy variant array NewData() back to Sheet2
xRng = NewData

End Sub

 

[Pearl]

Rick,

Good morning from the Gateway to the West. Thank you so much for your
reply. I am just beginning to get into writing macros and I still have a lot
to learn. It is harder than it looks.

I am not able to fix a problem within your macro. When I try to set the
range object; Set xRng = ws1.Range("A3:" & Chr(64 + lCol) & lRow) I get an
error message of Invalid procedure call or argument. What do I change to fix
this?

Respectfully,

Pearl

 

[Pearl]

Rick,

I got around my first obstacle by rewriting it. It probably is a goofy way
to do it but it worked. Now, I am unable to work my way through the part
that finds last row in xrng range:

lRow = xRng.End(xlDown).Row

I get a message of "Object variable or With block variable not set."

What do I do to get around this?

Respectfully,

Pearl

 

[Rick Hansen]

Good Morning Pearl, First let me ask, did you copy the code I send you into
new code module in the VBE? not into a sheet module. If Not Copy the code
into Fresh new code module in the VBE, and try the orginal code again. There
is another way to write this line of code, but I need to know if data in the
List is always using Columns A thru E only. If so then then the line of
code can be change to the following:
Set xRng = ws1.Range("A3:E" & lRow). If you haven't noticed by the
code, the first line of data list start in cell "A3". Post me back if you
have more problem. Also here is my email address rlhansen73.yahoo.com. If
I remember right the gate to the west is St. Louis

enjoy, Rick

 

[Pearl]

Rick,

I tried to email you directly, but I guess you did not receive it.

Thank you again for all your help. You have no idea how much I appreciate
it.

I can now get everything to work except the following loop:

'' don't break hold() boundaries, loop if compare string = to next Row

Loop While (i < UBound(hold, 1) And strhold = hold(iRow, 1) & hold(iRow, 2))

'' point to next row in NewData()

cnt = cnt + 1

'' don't break hold() boundaries and don't process if next row is empty

Loop While (i < UBound(hold, 1) And hold(iRow, 1) <> "")

I have attempted to correct this through various methods but have failed. I
have been able to correct other errors but not this one.

Yes, you are correct, the Gateway to the West is Saint Louis.

Respectfully,

Pearl

 

[Rick Hansen]

Pearl, Try to email me again at (e-mail address removed) or (e-mail address removed)
.. and we'll take it from there..

Rick (FBKS,AK)