+ Reply to Thread
Results 1 to 10 of 10

Macro to move info and delete duplicat records

  1. #1
    Bob Kopp
    Guest

    Macro to move info and delete duplicat records

    I am in the process of trying to learn VBA. I am trying to write a macro
    that will go through a list of data in excel and:

    1. Sort Data
    2. Find duplicates
    3.If duplicates are found, move certain information to open column of the
    master row
    4. Delete Duplicate row

    Problem

    Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
    0804706 BETCOCHEM AF79
    0804706 JOHNSONSON 4605
    0810295 CARLISLE 3663300
    0810295 CARLISLE (O)4155900

    Hopefull End result

    Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
    0804706 BETCOCHEM AF79 JOHNSONSON 4605
    0810295 CARLISLE 3663300 CARLISLE (O)4155900

    There will be multiple items that need to be moved to multiple columns.
    Bottom line is that I am trying to create unique item numbers that could have
    multiple part numbers.

    Any help would be much appreciated.

    thanks,

    bob



  2. #2
    RB Smissaert
    Guest

    Re: Macro to move info and delete duplicat records

    See if this code helps you out. It works with a given array, but you can
    make an array from a worksheet range and working with arrays is faster
    in any case.
    You may need some alterations to suit your particular needs.

    RBS


    Function SwingArray(ByRef arr1 As Variant, _
    ByRef colToTest As Long, _
    ByRef DoSort As Boolean, _
    ByRef StartCol As Long, _
    Optional ByRef lDiscardLastCols As Long = 0) _
    As Variant

    'takes one multi-column 2D array and swings the elements
    'that have the same value in colToTest to the row where
    'this value was found first. Column colToTest will only
    'hold unique values in the resulting array.
    'StartCol is the column where the copying of the elements
    'starts from.
    '--------------------------------------------------------
    Dim arr2()
    Dim i As Long
    Dim n As Long
    Dim c As Long
    Dim c2 As Long
    Dim c3 As Long
    Dim maxItems As Long
    Dim uCo As Long
    Dim LBR1 As Long
    Dim UBR1 As Long
    Dim LBC1 As Long
    Dim UBC1 As Long
    Dim tempIdx As Long
    Dim arrError(0 To 0)

    On Error GoTo ERROROUT

    LBR1 = LBound(arr1, 1)
    UBR1 = UBound(arr1, 1)
    LBC1 = LBound(arr1, 2)
    UBC1 = UBound(arr1, 2) - lDiscardLastCols

    'adjust UBR1 to account for empty elements
    'these empty element have to be at the
    'bottom of the array if they are there
    '-----------------------------------------
    For i = LBR1 To UBR1
    If arr1(i, colToTest) = Empty Then
    UBR1 = i - 1
    Exit For
    End If
    Next

    'sorting the supplied array ascending
    '------------------------------------
    If DoSort = True Then
    If PreSort2DArray(arr1, _
    "A", _
    colToTest) = False Then
    On Error GoTo 0
    SwingArray = False
    Exit Function
    End If
    End If

    'find and mark the doubles
    'get the maximum number of doubles
    '---------------------------------
    tempIdx = arr1(LBR1, colToTest)

    For i = LBR1 + 1 To UBR1
    If Not arr1(i, colToTest) = tempIdx Then
    tempIdx = arr1(i, colToTest)
    uCo = uCo + 1
    c2 = 0
    Else
    arr1(i, LBC1) = 0
    c2 = c2 + 1
    If c2 > maxItems Then
    maxItems = c2
    End If
    End If
    Next

    'adjust the final array
    'LBound will be as the original array
    '------------------------------------
    ReDim arr2(LBR1 To uCo + LBR1, _
    LBC1 To (UBC1) + maxItems * _
    (((UBC1 + 1) - StartCol)))

    n = LBR1 - 1

    'swing the elements from vertical to horizontal
    '----------------------------------------------
    For i = LBR1 To UBR1
    If Not arr1(i, LBC1) = 0 Then
    'copy first row in full
    n = n + 1
    For c = LBC1 To UBC1
    arr2(n, c) = arr1(i, c)
    Next
    c3 = UBC1 + 1
    Else
    'copy subsequent rows from specified start column
    '------------------------------------------------
    For c = StartCol To UBC1
    arr2(n, c3) = arr1(i, c)
    c3 = c3 + 1
    Next
    End If
    Next

    SwingArray = arr2

    On Error GoTo 0
    Exit Function
    ERROROUT:

    arrError(0) = "ERROR"
    SwingArray = arrError

    On Error GoTo 0
    End Function

    Function PreSort2DArray(ByRef avArray, _
    ByRef sOrder As String, _
    ByRef iKey As Long, _
    Optional ByRef iLow1 As Long = -1, _
    Optional ByRef iHigh1 As Long = -1) _
    As Boolean

    'the routine procSort2D can't handle large arrays
    'causing an error out of stack space
    'this is handled by sorting increasing larger parts
    'of the array, so that there is less to be done when
    'the whole array gets sorted
    '---------------------------------------------------

    Dim LR As Long
    Dim lPreSorts As Long
    Dim lArrayChunk As Long
    Dim n As Long

    LR = UBound(avArray)

    'this value may depend on the hardware
    '-------------------------------------
    lArrayChunk = 8000

    'no need to do pre-sorts
    '-----------------------
    If LR < lArrayChunk Then
    PreSort2DArray = procSort2D(avArray, _
    sOrder, _
    iKey, _
    iLow1, _
    iHigh1)
    Exit Function
    End If

    lPreSorts = LR \ lArrayChunk

    For n = 0 To lPreSorts
    If n < lPreSorts Then
    'increase the part of the array in steps of lArrayChunk
    '------------------------------------------------------
    PreSort2DArray = procSort2D(avArray, _
    sOrder, _
    iKey, _
    iLow1, _
    (n + 1) * lArrayChunk)
    Else
    'sort the whole array
    '--------------------
    PreSort2DArray = procSort2D(avArray, _
    sOrder, _
    iKey, _
    iLow1, _
    iHigh1)
    End If
    Next

    End Function

    Function procSort2D(ByRef avArray, _
    ByRef sOrder As String, _
    ByRef iKey As Long, _
    Optional ByRef iLow1 As Long = -1, _
    Optional ByRef iHigh1 As Long = -1) _
    As Boolean

    Dim iLow2 As Long
    Dim iHigh2 As Long
    Dim i As Long
    Dim vItem1 As Variant
    Dim vItem2 As Variant

    On Error GoTo ERROROUT

    If iLow1 = -1 Then
    iLow1 = LBound(avArray, 1)
    End If

    If iHigh1 = -1 Then
    iHigh1 = UBound(avArray, 1)
    End If

    'Set new extremes to old extremes
    iLow2 = iLow1
    iHigh2 = iHigh1

    'Get value of array item in middle of new extremes
    vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)

    'Loop for all the items in the array between the extremes
    While iLow2 < iHigh2

    If sOrder = "A" Then
    'Find the first item that is greater than the mid-point item
    While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
    iLow2 = iLow2 + 1
    Wend

    'Find the last item that is less than the mid-point item
    While avArray(iHigh2, iKey) > vItem1 And iHigh2 > iLow1
    iHigh2 = iHigh2 - 1
    Wend
    Else
    'Find the first item that is less than the mid-point item
    While avArray(iLow2, iKey) > vItem1 And iLow2 < iHigh1
    iLow2 = iLow2 + 1
    Wend

    'Find the last item that is greater than the mid-point item
    While avArray(iHigh2, iKey) < vItem1 And iHigh2 > iLow1
    iHigh2 = iHigh2 - 1
    Wend
    End If

    'If the two items are in the wrong order, swap the rows
    If iLow2 < iHigh2 Then
    For i = LBound(avArray) To UBound(avArray, 2)
    vItem2 = avArray(iLow2, i)
    avArray(iLow2, i) = avArray(iHigh2, i)
    avArray(iHigh2, i) = vItem2
    Next
    End If

    'If the pointers are not together, advance to the next item
    If iLow2 <= iHigh2 Then
    iLow2 = iLow2 + 1
    iHigh2 = iHigh2 - 1
    End If
    Wend

    'Recurse to sort the lower half of the extremes
    If iHigh2 > iLow1 Then
    procSort2D avArray, _
    sOrder, _
    iKey, _
    iLow1, _
    iHigh2
    End If

    'Recurse to sort the upper half of the extremes
    If iLow2 < iHigh1 Then
    procSort2D avArray, _
    sOrder, _
    iKey, _
    iLow2, _
    iHigh1
    End If

    procSort2D = True

    Exit Function
    ERROROUT:

    procSort2D = False

    End Function



    "Bob Kopp" <Bob [email protected]> wrote in message
    news:[email protected]...
    >I am in the process of trying to learn VBA. I am trying to write a macro
    > that will go through a list of data in excel and:
    >
    > 1. Sort Data
    > 2. Find duplicates
    > 3.If duplicates are found, move certain information to open column of the
    > master row
    > 4. Delete Duplicate row
    >
    > Problem
    >
    > Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
    > 0804706 BETCOCHEM AF79
    > 0804706 JOHNSONSON 4605
    > 0810295 CARLISLE 3663300
    > 0810295 CARLISLE (O)4155900
    >
    > Hopefull End result
    >
    > Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
    > 0804706 BETCOCHEM AF79 JOHNSONSON 4605
    > 0810295 CARLISLE 3663300 CARLISLE (O)4155900
    >
    > There will be multiple items that need to be moved to multiple columns.
    > Bottom line is that I am trying to create unique item numbers that could
    > have
    > multiple part numbers.
    >
    > Any help would be much appreciated.
    >
    > thanks,
    >
    > bob
    >
    >



  3. #3
    PCLIVE
    Guest

    Re: Macro to move info and delete duplicat records

    Bob,

    Here is something to get you started.
    This code takes A1 to B20 and sorts it in ascending order based on column A.
    It then steps through and clears entire rows when it reaches a duplicate
    value incolumn A. As for moving the duplicate information to another
    location, that will need to be worked out prior to deleting the entire row.

    Sub RemoveDuplicate()

    Range("A1:B20").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo,
    _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

    colnum = Selection(1).Column
    For rowndx = Selection(Selection.Cells.Count).Row To _
    Selection(1).Row + 1 Step -1
    c = "A" & Cells(rowndx, colnum).Row
    If Cells(rowndx, colnum).Value = Cells(rowndx - 1, colnum).Value
    Then

    'Additional code to move data to another location would go here

    Range(c).EntireRow.Delete
    End If
    Next rowndx

    End Sub





    "Bob Kopp" <Bob [email protected]> wrote in message
    news:[email protected]...
    >I am in the process of trying to learn VBA. I am trying to write a macro
    > that will go through a list of data in excel and:
    >
    > 1. Sort Data
    > 2. Find duplicates
    > 3.If duplicates are found, move certain information to open column of the
    > master row
    > 4. Delete Duplicate row
    >
    > Problem
    >
    > Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
    > 0804706 BETCOCHEM AF79
    > 0804706 JOHNSONSON 4605
    > 0810295 CARLISLE 3663300
    > 0810295 CARLISLE (O)4155900
    >
    > Hopefull End result
    >
    > Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
    > 0804706 BETCOCHEM AF79 JOHNSONSON 4605
    > 0810295 CARLISLE 3663300 CARLISLE (O)4155900
    >
    > There will be multiple items that need to be moved to multiple columns.
    > Bottom line is that I am trying to create unique item numbers that could
    > have
    > multiple part numbers.
    >
    > Any help would be much appreciated.
    >
    > thanks,
    >
    > bob
    >
    >




  4. #4
    RB Smissaert
    Guest

    Re: Macro to move info and delete duplicat records

    Maybe you need an example to see how this works.
    If we take the data as in your example, without the fields it would go like
    this:

    Sub Test()

    Dim arr

    arr = Range(Cells(1), Cells(4, 3))
    arr = SwingArray(arr, 1, False, 2, 0)
    Range(Cells(5), Cells(UBound(arr), 4 + UBound(arr, 2))) = arr

    End Sub


    RBS

    "Bob Kopp" <Bob [email protected]> wrote in message
    news:[email protected]...
    >I am in the process of trying to learn VBA. I am trying to write a macro
    > that will go through a list of data in excel and:
    >
    > 1. Sort Data
    > 2. Find duplicates
    > 3.If duplicates are found, move certain information to open column of the
    > master row
    > 4. Delete Duplicate row
    >
    > Problem
    >
    > Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
    > 0804706 BETCOCHEM AF79
    > 0804706 JOHNSONSON 4605
    > 0810295 CARLISLE 3663300
    > 0810295 CARLISLE (O)4155900
    >
    > Hopefull End result
    >
    > Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
    > 0804706 BETCOCHEM AF79 JOHNSONSON 4605
    > 0810295 CARLISLE 3663300 CARLISLE (O)4155900
    >
    > There will be multiple items that need to be moved to multiple columns.
    > Bottom line is that I am trying to create unique item numbers that could
    > have
    > multiple part numbers.
    >
    > Any help would be much appreciated.
    >
    > thanks,
    >
    > bob
    >
    >



  5. #5
    Bob Kopp
    Guest

    RE: Macro to move info and delete duplicat records

    RB Smissaert

    I am playing with the code you provided me, but I am still very much a
    noivce when it comes to the VBA programing language.

    bob

    "Bob Kopp" wrote:

    > I am in the process of trying to learn VBA. I am trying to write a macro
    > that will go through a list of data in excel and:
    >
    > 1. Sort Data
    > 2. Find duplicates
    > 3.If duplicates are found, move certain information to open column of the
    > master row
    > 4. Delete Duplicate row
    >
    > Problem
    >
    > Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
    > 0804706 BETCOCHEM AF79
    > 0804706 JOHNSONSON 4605
    > 0810295 CARLISLE 3663300
    > 0810295 CARLISLE (O)4155900
    >
    > Hopefull End result
    >
    > Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
    > 0804706 BETCOCHEM AF79 JOHNSONSON 4605
    > 0810295 CARLISLE 3663300 CARLISLE (O)4155900
    >
    > There will be multiple items that need to be moved to multiple columns.
    > Bottom line is that I am trying to create unique item numbers that could have
    > multiple part numbers.
    >
    > Any help would be much appreciated.
    >
    > thanks,
    >
    > bob
    >
    >


  6. #6
    RB Smissaert
    Guest

    Re: Macro to move info and delete duplicat records

    You don't have to understand it and the example I gave should work.
    Only if you have to make adjustments will it need some understanding
    what is going on. In that case just post back to this NG.

    RBS

    "Bob Kopp" <[email protected]> wrote in message
    news:[email protected]...
    > RB Smissaert
    >
    > I am playing with the code you provided me, but I am still very much a
    > noivce when it comes to the VBA programing language.
    >
    > bob
    >
    > "Bob Kopp" wrote:
    >
    >> I am in the process of trying to learn VBA. I am trying to write a macro
    >> that will go through a list of data in excel and:
    >>
    >> 1. Sort Data
    >> 2. Find duplicates
    >> 3.If duplicates are found, move certain information to open column of the
    >> master row
    >> 4. Delete Duplicate row
    >>
    >> Problem
    >>
    >> Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
    >> 0804706 BETCOCHEM AF79
    >> 0804706 JOHNSONSON 4605
    >> 0810295 CARLISLE 3663300
    >> 0810295 CARLISLE (O)4155900
    >>
    >> Hopefull End result
    >>
    >> Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
    >> 0804706 BETCOCHEM AF79 JOHNSONSON 4605
    >> 0810295 CARLISLE 3663300 CARLISLE (O)4155900
    >>
    >> There will be multiple items that need to be moved to multiple columns.
    >> Bottom line is that I am trying to create unique item numbers that could
    >> have
    >> multiple part numbers.
    >>
    >> Any help would be much appreciated.
    >>
    >> thanks,
    >>
    >> bob
    >>
    >>



  7. #7
    Bob Kopp
    Guest

    Re: Macro to move info and delete duplicat records

    RBS

    When I run the code that you just sent me to create the array, It gets hung
    up on line:

    Range(Cells(5), Cells(UBound(arr), 4 + UBound(arr, 2))) = arr

    Also would I have to rename arr to arr1 in order for it to get read by the
    previous code that you sent me? If not, how does the array that this code
    creates get brought into that code?

    thanks,

    bob

    "RB Smissaert" wrote:

    > You don't have to understand it and the example I gave should work.
    > Only if you have to make adjustments will it need some understanding
    > what is going on. In that case just post back to this NG.
    >
    > RBS
    >
    > "Bob Kopp" <[email protected]> wrote in message
    > news:[email protected]...
    > > RB Smissaert
    > >
    > > I am playing with the code you provided me, but I am still very much a
    > > noivce when it comes to the VBA programing language.
    > >
    > > bob
    > >
    > > "Bob Kopp" wrote:
    > >
    > >> I am in the process of trying to learn VBA. I am trying to write a macro
    > >> that will go through a list of data in excel and:
    > >>
    > >> 1. Sort Data
    > >> 2. Find duplicates
    > >> 3.If duplicates are found, move certain information to open column of the
    > >> master row
    > >> 4. Delete Duplicate row
    > >>
    > >> Problem
    > >>
    > >> Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
    > >> 0804706 BETCOCHEM AF79
    > >> 0804706 JOHNSONSON 4605
    > >> 0810295 CARLISLE 3663300
    > >> 0810295 CARLISLE (O)4155900
    > >>
    > >> Hopefull End result
    > >>
    > >> Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
    > >> 0804706 BETCOCHEM AF79 JOHNSONSON 4605
    > >> 0810295 CARLISLE 3663300 CARLISLE (O)4155900
    > >>
    > >> There will be multiple items that need to be moved to multiple columns.
    > >> Bottom line is that I am trying to create unique item numbers that could
    > >> have
    > >> multiple part numbers.
    > >>
    > >> Any help would be much appreciated.
    > >>
    > >> thanks,
    > >>
    > >> bob
    > >>
    > >>

    >
    >


  8. #8
    RB Smissaert
    Guest

    Re: Macro to move info and delete duplicat records

    Did you have your example data in the range starting at A1?
    It works fine with me.

    > Also would I have to rename arr to arr1 in order for it to get read by the
    > previous code that you sent me?


    No, it doesn't matter how you call the array in the example Sub.
    There is no relation between the array names in the function and the array
    name in the calling Sub.

    If you have the data in range A1 : C4 and run this Sub:

    Sub Test()

    Dim arr
    Dim lStartPasteCol As Long

    lStartPasteCol = 5

    arr = Range(Cells(1), Cells(4, 3))
    arr = SwingArray(arr, 1, False, 2, 0)
    Range(Cells(lStartPasteCol), _
    Cells(UBound(arr), _
    (lStartPasteCol - 1) + UBound(arr, 2))) = arr

    End Sub

    It should just work fine.


    RBS



    "Bob Kopp" <[email protected]> wrote in message
    news:[email protected]...
    > RBS
    >
    > When I run the code that you just sent me to create the array, It gets
    > hung
    > up on line:
    >
    > Range(Cells(5), Cells(UBound(arr), 4 + UBound(arr, 2))) = arr
    >
    > Also would I have to rename arr to arr1 in order for it to get read by the
    > previous code that you sent me? If not, how does the array that this code
    > creates get brought into that code?
    >
    > thanks,
    >
    > bob
    >
    > "RB Smissaert" wrote:
    >
    >> You don't have to understand it and the example I gave should work.
    >> Only if you have to make adjustments will it need some understanding
    >> what is going on. In that case just post back to this NG.
    >>
    >> RBS
    >>
    >> "Bob Kopp" <[email protected]> wrote in message
    >> news:[email protected]...
    >> > RB Smissaert
    >> >
    >> > I am playing with the code you provided me, but I am still very much a
    >> > noivce when it comes to the VBA programing language.
    >> >
    >> > bob
    >> >
    >> > "Bob Kopp" wrote:
    >> >
    >> >> I am in the process of trying to learn VBA. I am trying to write a
    >> >> macro
    >> >> that will go through a list of data in excel and:
    >> >>
    >> >> 1. Sort Data
    >> >> 2. Find duplicates
    >> >> 3.If duplicates are found, move certain information to open column of
    >> >> the
    >> >> master row
    >> >> 4. Delete Duplicate row
    >> >>
    >> >> Problem
    >> >>
    >> >> Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
    >> >> 0804706 BETCOCHEM AF79
    >> >> 0804706 JOHNSONSON 4605
    >> >> 0810295 CARLISLE 3663300
    >> >> 0810295 CARLISLE (O)4155900
    >> >>
    >> >> Hopefull End result
    >> >>
    >> >> Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
    >> >> 0804706 BETCOCHEM AF79 JOHNSONSON 4605
    >> >> 0810295 CARLISLE 3663300 CARLISLE (O)4155900
    >> >>
    >> >> There will be multiple items that need to be moved to multiple
    >> >> columns.
    >> >> Bottom line is that I am trying to create unique item numbers that
    >> >> could
    >> >> have
    >> >> multiple part numbers.
    >> >>
    >> >> Any help would be much appreciated.
    >> >>
    >> >> thanks,
    >> >>
    >> >> bob
    >> >>
    >> >>

    >>
    >>



  9. #9
    Bob Kopp
    Guest

    Re: Macro to move info and delete duplicat records

    RBS

    Thanks, that worked much better. I had titles in the first row when I ran
    the macro and it did not like it. I just have to figure out how to delete
    the row of data that I just moved for a particular item before it performs
    the same action on the next row (item).

    Data before Macro

    0804706 BETCOCHEM AF79
    0804706 JOHNSONSON 4605
    0810295 CARLISLE 3663300
    0810295 CARLISLE (O)4155900

    Data after Macro

    0804706 BETCOCHEM AF79 804706 BETCOCHEM AF79 JOHNSONSON 4605
    0804706 JOHNSONSON 4605 810295 CARLISLE 3663300 CARLISLE (O)4155900
    0810295 CARLISLE 3663300
    0810295 CARLISLE (O)4155900

    The Mfg info for item 0810295 got put on the same line as item 0804706.
    After the data gets moved I need to delete row that the data was moved from.
    I will have items with 4 or more MFG info that needs to be transcribed to one
    item number.

    You have been a great help so far and I appreciate your patience.

    thanks,

    bob




    "RB Smissaert" wrote:

    > Did you have your example data in the range starting at A1?
    > It works fine with me.
    >
    > > Also would I have to rename arr to arr1 in order for it to get read by the
    > > previous code that you sent me?

    >
    > No, it doesn't matter how you call the array in the example Sub.
    > There is no relation between the array names in the function and the array
    > name in the calling Sub.
    >
    > If you have the data in range A1 : C4 and run this Sub:
    >
    > Sub Test()
    >
    > Dim arr
    > Dim lStartPasteCol As Long
    >
    > lStartPasteCol = 5
    >
    > arr = Range(Cells(1), Cells(4, 3))
    > arr = SwingArray(arr, 1, False, 2, 0)
    > Range(Cells(lStartPasteCol), _
    > Cells(UBound(arr), _
    > (lStartPasteCol - 1) + UBound(arr, 2))) = arr
    >
    > End Sub
    >
    > It should just work fine.
    >
    >
    > RBS
    >
    >
    >
    > "Bob Kopp" <[email protected]> wrote in message
    > news:[email protected]...
    > > RBS
    > >
    > > When I run the code that you just sent me to create the array, It gets
    > > hung
    > > up on line:
    > >
    > > Range(Cells(5), Cells(UBound(arr), 4 + UBound(arr, 2))) = arr
    > >
    > > Also would I have to rename arr to arr1 in order for it to get read by the
    > > previous code that you sent me? If not, how does the array that this code
    > > creates get brought into that code?
    > >
    > > thanks,
    > >
    > > bob
    > >
    > > "RB Smissaert" wrote:
    > >
    > >> You don't have to understand it and the example I gave should work.
    > >> Only if you have to make adjustments will it need some understanding
    > >> what is going on. In that case just post back to this NG.
    > >>
    > >> RBS
    > >>
    > >> "Bob Kopp" <[email protected]> wrote in message
    > >> news:[email protected]...
    > >> > RB Smissaert
    > >> >
    > >> > I am playing with the code you provided me, but I am still very much a
    > >> > noivce when it comes to the VBA programing language.
    > >> >
    > >> > bob
    > >> >
    > >> > "Bob Kopp" wrote:
    > >> >
    > >> >> I am in the process of trying to learn VBA. I am trying to write a
    > >> >> macro
    > >> >> that will go through a list of data in excel and:
    > >> >>
    > >> >> 1. Sort Data
    > >> >> 2. Find duplicates
    > >> >> 3.If duplicates are found, move certain information to open column of
    > >> >> the
    > >> >> master row
    > >> >> 4. Delete Duplicate row
    > >> >>
    > >> >> Problem
    > >> >>
    > >> >> Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
    > >> >> 0804706 BETCOCHEM AF79
    > >> >> 0804706 JOHNSONSON 4605
    > >> >> 0810295 CARLISLE 3663300
    > >> >> 0810295 CARLISLE (O)4155900
    > >> >>
    > >> >> Hopefull End result
    > >> >>
    > >> >> Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
    > >> >> 0804706 BETCOCHEM AF79 JOHNSONSON 4605
    > >> >> 0810295 CARLISLE 3663300 CARLISLE (O)4155900
    > >> >>
    > >> >> There will be multiple items that need to be moved to multiple
    > >> >> columns.
    > >> >> Bottom line is that I am trying to create unique item numbers that
    > >> >> could
    > >> >> have
    > >> >> multiple part numbers.
    > >> >>
    > >> >> Any help would be much appreciated.
    > >> >>
    > >> >> thanks,
    > >> >>
    > >> >> bob
    > >> >>
    > >> >>
    > >>
    > >>

    >
    >


  10. #10
    RB Smissaert
    Guest

    Re: Macro to move info and delete duplicat records

    > I just have to figure out how to delete the row of data that I just moved
    > for a particular item before it performs the same action on the next row
    > (item).


    You don't have to delete any rows.
    If you want the data to go the same range as the original data you can do
    something like this:
    Again using the same data, without the fields.

    Sub Test()

    Dim rngOriginal As Range
    Dim arr
    Dim lStartPasteCol As Long

    Set rngOriginal = Range(Cells(1), Cells(4, 3))
    lStartPasteCol = 1

    arr = rngOriginal
    arr = SwingArray(arr, 1, False, 2, 0)
    rngOriginal.Clear
    Range(Cells(lStartPasteCol), _
    Cells(UBound(arr), _
    (lStartPasteCol - 1) + UBound(arr, 2))) = arr

    End Sub

    In general it is always best to do as much work in arrays and not in ranges
    as it will be faster.
    If needed you could add some code to deal with the fields.


    RBS


    "Bob Kopp" <[email protected]> wrote in message
    news:[email protected]...
    > RBS
    >
    > Thanks, that worked much better. I had titles in the first row when I ran
    > the macro and it did not like it. I just have to figure out how to delete
    > the row of data that I just moved for a particular item before it performs
    > the same action on the next row (item).
    >
    > Data before Macro
    >
    > 0804706 BETCOCHEM AF79
    > 0804706 JOHNSONSON 4605
    > 0810295 CARLISLE 3663300
    > 0810295 CARLISLE (O)4155900
    >
    > Data after Macro
    >
    > 0804706 BETCOCHEM AF79 804706 BETCOCHEM AF79 JOHNSONSON 4605
    > 0804706 JOHNSONSON 4605 810295 CARLISLE 3663300 CARLISLE (O)4155900
    > 0810295 CARLISLE 3663300
    > 0810295 CARLISLE (O)4155900
    >
    > The Mfg info for item 0810295 got put on the same line as item 0804706.
    > After the data gets moved I need to delete row that the data was moved
    > from.
    > I will have items with 4 or more MFG info that needs to be transcribed to
    > one
    > item number.
    >
    > You have been a great help so far and I appreciate your patience.
    >
    > thanks,
    >
    > bob
    >
    >
    >
    >
    > "RB Smissaert" wrote:
    >
    >> Did you have your example data in the range starting at A1?
    >> It works fine with me.
    >>
    >> > Also would I have to rename arr to arr1 in order for it to get read by
    >> > the
    >> > previous code that you sent me?

    >>
    >> No, it doesn't matter how you call the array in the example Sub.
    >> There is no relation between the array names in the function and the
    >> array
    >> name in the calling Sub.
    >>
    >> If you have the data in range A1 : C4 and run this Sub:
    >>
    >> Sub Test()
    >>
    >> Dim arr
    >> Dim lStartPasteCol As Long
    >>
    >> lStartPasteCol = 5
    >>
    >> arr = Range(Cells(1), Cells(4, 3))
    >> arr = SwingArray(arr, 1, False, 2, 0)
    >> Range(Cells(lStartPasteCol), _
    >> Cells(UBound(arr), _
    >> (lStartPasteCol - 1) + UBound(arr, 2))) = arr
    >>
    >> End Sub
    >>
    >> It should just work fine.
    >>
    >>
    >> RBS
    >>
    >>
    >>
    >> "Bob Kopp" <[email protected]> wrote in message
    >> news:[email protected]...
    >> > RBS
    >> >
    >> > When I run the code that you just sent me to create the array, It gets
    >> > hung
    >> > up on line:
    >> >
    >> > Range(Cells(5), Cells(UBound(arr), 4 + UBound(arr, 2))) = arr
    >> >
    >> > Also would I have to rename arr to arr1 in order for it to get read by
    >> > the
    >> > previous code that you sent me? If not, how does the array that this
    >> > code
    >> > creates get brought into that code?
    >> >
    >> > thanks,
    >> >
    >> > bob
    >> >
    >> > "RB Smissaert" wrote:
    >> >
    >> >> You don't have to understand it and the example I gave should work.
    >> >> Only if you have to make adjustments will it need some understanding
    >> >> what is going on. In that case just post back to this NG.
    >> >>
    >> >> RBS
    >> >>
    >> >> "Bob Kopp" <[email protected]> wrote in message
    >> >> news:[email protected]...
    >> >> > RB Smissaert
    >> >> >
    >> >> > I am playing with the code you provided me, but I am still very much
    >> >> > a
    >> >> > noivce when it comes to the VBA programing language.
    >> >> >
    >> >> > bob
    >> >> >
    >> >> > "Bob Kopp" wrote:
    >> >> >
    >> >> >> I am in the process of trying to learn VBA. I am trying to write a
    >> >> >> macro
    >> >> >> that will go through a list of data in excel and:
    >> >> >>
    >> >> >> 1. Sort Data
    >> >> >> 2. Find duplicates
    >> >> >> 3.If duplicates are found, move certain information to open column
    >> >> >> of
    >> >> >> the
    >> >> >> master row
    >> >> >> 4. Delete Duplicate row
    >> >> >>
    >> >> >> Problem
    >> >> >>
    >> >> >> Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
    >> >> >> 0804706 BETCOCHEM AF79
    >> >> >> 0804706 JOHNSONSON 4605
    >> >> >> 0810295 CARLISLE 3663300
    >> >> >> 0810295 CARLISLE (O)4155900
    >> >> >>
    >> >> >> Hopefull End result
    >> >> >>
    >> >> >> Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm
    >> >> >> ID-1
    >> >> >> 0804706 BETCOCHEM AF79 JOHNSONSON 4605
    >> >> >> 0810295 CARLISLE 3663300 CARLISLE (O)4155900
    >> >> >>
    >> >> >> There will be multiple items that need to be moved to multiple
    >> >> >> columns.
    >> >> >> Bottom line is that I am trying to create unique item numbers that
    >> >> >> could
    >> >> >> have
    >> >> >> multiple part numbers.
    >> >> >>
    >> >> >> Any help would be much appreciated.
    >> >> >>
    >> >> >> thanks,
    >> >> >>
    >> >> >> bob
    >> >> >>
    >> >> >>
    >> >>
    >> >>

    >>
    >>



+ 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