Results 1 to 2 of 2
  1. #1
    Join Date
    Nov 2005
    Posts
    91

    Unanswered: VB Macro - Using Loops To Identify Duplicate Entries

    I was wondering if anyone would be able to help me out with creating a VB macro in excel that checks each consecutive line for a duplicate entry. If there is a duplicate entry on the following line then the functions checks the next line after so on and so forth until there are either no more items in the list or no more consecutive matches in the list. Once all possible line matches are found, I then want to concatenate a cell from each of the corresponding line matches into one cell.

    Below is an example of the source data that I am working with.

    Name item
    Bob 123
    Bob 456
    Bob 789
    John 012
    John 345
    Tina 678

    The result that I am looking for should look like the list below. Since I am looking for a distinct list of names and another column with concatenated items I would delete all duplicate name rows except for the first occurrence which would contain all the item numbers

    Name item Combined items
    Bob 123 123 345 789
    Bob 456 459 789
    Bob 789 789
    John 012 012 345
    John 345 345
    Tina 678 678


    final result
    Name item Combined items
    Bob 123 123 345 789
    John 012 012 345
    Tina 678 678


    I can make do with deleting all the duplicate rows once each first distinct instance contains a list of all the items. The part that I do need help with the most is creating a VB macro that can automate the concatenation process through a loop. This is a daily task that I have to do and the number of rows and duplicate items vary each day. I can create code in VB to automate the task but it would be hard coded for that days particular instance. Below is what I have coded so far. Anyones help with creating a VB macro that I would not have to constantly modify would greatly be appreciated.


    Sub test()
    If Range("A1") = Range("A2") Then
    If Range("A2") = Range("A3") Then
    If Range("A3") = Range("A4") Then
    Range("c1") = Range("b1") & " " & Range("b2") & " " & Range("b3") & " " & Range("b4")
    Else
    Range("c1") = Range("b1") & " " & Range("b2") & " " & Range("b3")
    End If
    Else
    Range("c1") = Range("b1") & " " & Range("b2")
    End If
    Else
    Range("c1") = Range("b1")
    End If

    End Sub



    Thanks

  2. #2
    Join Date
    Apr 2004
    Location
    Derbyshire, UK
    Posts
    789
    Provided Answers: 1
    Hi

    May be this will do it for you

    Code:
    Option Explicit
    Type CollateData_Type
        Name As String
        Numbers As String
        Count As Long
    End Type
    
    Sub CollateNumbers()
        Const cStartRow As Long = 2
        Dim Collated() As CollateData_Type
        Dim iRow As Long
        Dim i As Long
        
        ReDim Collated(0)
        Collated(0).Name = "Blank"
        iRow = cStartRow
        Do Until Cells(iRow, 1) = ""
            For i = 1 To UBound(Collated)
                With Collated(i)
                    If Trim(Cells(iRow, 1)) = .Name Then
                        .Numbers = .Numbers & " " & Cells(iRow, 2)
                        .Count = .Count + 1
                        Exit For
                    End If
                End With
            Next i
            If i > UBound(Collated) Then
                ReDim Preserve Collated(i)
                With Collated(i)
                    .Name = Trim(Cells(iRow, 1))
                    .Numbers = .Numbers & " " & Cells(iRow, 2) & " " & Cells(iRow, 2)
                    .Count = .Count + 1
                End With
            End If
            iRow = iRow + 1
        Loop
        iRow = cStartRow
        For i = 1 To UBound(Collated)
            With Collated(i)
                Cells(iRow, 4) = .Name & " (" & .Count & " numbers found)"
                Cells(iRow, 5) = .Numbers
            End With
            iRow = iRow + 1
        Next i
    End Sub
    It is not quite what you posted, but you should be able to mod to suit !?

    Note: this is case sensitive. If required use UCase() or LCase() to remove case sensitivity.

    Any probs then post back.

    MTB

Posting Permissions

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