Solved: A Duplicate finder and Merge all in one

[Rucas]

Hey all,
Was after some assistance in either writing or finding a macro that can help me achieve the following

Need to find multiple listings of same addresses and merge names of people who live there and delete duplicate

Needs to first find duplicate rows based upon exact match of Column A and B
Then once found, Merge the contents of Column C together.
Then deletes duplicate
Example
Row 1
Col A = 21
Col B = Foobar Way
Col C = Mick Jagger

Row 2
Col A = 21
Col B = Foobar Way
Col C = Bob Marley

End Result is Row 1 and 2 found to be duplicate, Row 1 Col C has now a value of "Mick Jagger & Bob Marley" and Row 2 is then deleted

Any assistance would be appriciated

Hope this all makes sense :)

Cheers

[acw]

Hi

This is pretty clumsy but try


Type mytype
street As String
row As Long
End Type
Sub bbb()
Dim arr() As mytype

cntr = 1
ReDim Preserve arr(cntr)
arr(cntr).street = Range("a1").Value & Range("B1").Value
arr(cntr).row = 1
For Each ce In Range("A2:A4")
For i = 1 To cntr
If arr(i).street = ce.Value & ce.Offset(0, 1).Value Then
Cells(arr(i).row, 3).Value = Cells(arr(i).row, 3).Value & " & " & ce.Offset(0, 2).Value
ce.EntireRow.ClearContents
i = cntr
Else
cntr = cntr + 1
ReDim Preserve arr(cntr)
arr(cntr).street = ce.Value & ce.Offset(0, 1).Value
arr(cntr).row = ce.row
End If

Next i
Next ce
Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub




Tony

[Ken Puls]

Hi there,

For dealing with duplicates, I always like to recommend Dave Brett's (http://www.vbaexpress.com/forum/member.php?u=32) Duplicate Master (http://members.iinet.net.au/~brettdj/).

I'm trying to visualize your data though, and I'm not sure if this would work for you or not...

[rbrhodes]

Hi Rucas,

This might work.


Sub DeleteAndMerge()

Dim i As Long
Dim dCol As Long
Dim lrow As Long

'Column to check first (A)
dCol = 1

'Get last row of data, Col A
lrow = Cells(65536, dCol).End(xlUp).Row

'Check each row: lastrow to row 2
For i = lrow To 2 Step -1

'If Col A AND Col B are match
If Cells(i, 1) = Cells(i - 1, 1) And Cells(i, 2) = Cells(i - 1, 2) Then

'Col C = Concatentate Col C names
Cells(i - 1, 3) = Cells(i - 1, 3) & " & " & Cells(i, 3)

'Delete dupe row
Cells(i, 1).EntireRow.Delete
End If
Next i
End Sub


Cheers,

dr

[Rucas]

Hi Rucas,

This might work.


Sub DeleteAndMerge()

Dim i As Long
Dim dCol As Long
Dim lrow As Long

'Column to check first (A)
dCol = 1

'Get last row of data, Col A
lrow = Cells(65536, dCol).End(xlUp).Row

'Check each row: lastrow to row 2
For i = lrow To 2 Step -1

'If Col A AND Col B are match
If Cells(i, 1) = Cells(i - 1, 1) And Cells(i, 2) = Cells(i - 1, 2) Then

'Col C = Concatentate Col C names
Cells(i - 1, 3) = Cells(i - 1, 3) & " & " & Cells(i, 3)

'Delete dupe row
Cells(i, 1).EntireRow.Delete
End If
Next i
End Sub


Cheers,

dr

Worked beautifully.. exactly what I needed
Couldn't of asked for more..
Thankyou soo much :)