+ Reply to Thread
Results 1 to 8 of 8

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

  1. #1
    Pearl
    Guest

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

    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?




  2. #2
    Rick Hansen
    Guest

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


    "Pearl" <[email protected]> wrote in message
    news:[email protected]...
    > 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?
    >
    >
    >




  3. #3
    Rick Hansen
    Guest

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

    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" <[email protected]> wrote in message
    news:[email protected]...
    > 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?
    >
    >
    >




  4. #4
    Pearl
    Guest

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

    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



    "Rick Hansen" wrote:

    > 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" <[email protected]> wrote in message
    > news:[email protected]...
    > > 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?
    > >
    > >
    > >

    >
    >
    >


  5. #5
    Pearl
    Guest

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

    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" wrote:

    > 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" <[email protected]> wrote in message
    > news:[email protected]...
    > > 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?
    > >
    > >
    > >

    >
    >
    >


  6. #6
    Rick Hansen
    Guest

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

    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" <[email protected]> wrote in message
    news:[email protected]...
    > 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
    >
    >
    >
    > "Rick Hansen" wrote:
    >
    > > 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" <[email protected]> wrote in message
    > > news:[email protected]...
    > > > 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?
    > > >
    > > >
    > > >

    > >
    > >
    > >




  7. #7
    Pearl
    Guest

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

    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" wrote:

    > 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" <[email protected]> wrote in message
    > news:[email protected]...
    > > 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
    > >
    > >
    > >
    > > "Rick Hansen" wrote:
    > >
    > > > 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" <[email protected]> wrote in message
    > > > news:[email protected]...
    > > > > 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?
    > > > >
    > > > >
    > > > >
    > > >
    > > >
    > > >

    >
    >
    >


  8. #8
    Rick Hansen
    Guest

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

    Pearl, Try to email me again at [email protected] or [email protected]
    .. and we'll take it from there..

    Rick (FBKS,AK)




    "Pearl" <[email protected]> wrote in message
    news:[email protected]...
    > 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" wrote:
    >
    > > 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" <[email protected]> wrote in message
    > > news:[email protected]...
    > > > 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
    > > >
    > > >
    > > >
    > > > "Rick Hansen" wrote:
    > > >
    > > > > 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" <[email protected]> wrote in message
    > > > > news:[email protected]...
    > > > > > 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?
    > > > > >
    > > > > >
    > > > > >
    > > > >
    > > > >
    > > > >

    > >
    > >
    > >




+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1