VB Macro - Using Loops To Identify Duplicate Entries

dsmbwoy · #1 (**permalink**) 09-24-07, 21:56

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

MikeTheBike · #2 (**permalink**) 10-05-07, 05:56

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

Internet Services

Web Development

Digital Marketing

Consumer Tech