Complex Sorting Macro for names & emails

[Justijb]

Good Morning All,

As always I like to start off my posts with saying thank you to everyone who responds and provides assistance. I have a tough one to crack...I need to create a code/script that sorts 5 columns of data. First column is (A) last name, first name (exact format). Second column (B) is email address, third column (C) date, (D) is address, and finally (E) is comments.

What I need is to sort column A by name of family. Meaning, two rows will have the same email address because two people in that family use the same email address. that would need to sorted onto one row. It would need to delete that row with the information, sort it into the previous row. So Row 3 is John Doe, Row 4 is Jane Doe, I need move data from row 4 and insert into row 3. This needs to be done for about 4k records. Note: What would even be more awesome if there is a way to make the name into a family name. So if column (a) has two same names in two different rows to make it as John & Jane Doe in column a, have one single email in column B ,etc.

Hopefully, my request is clear and concise. Any assistance would be very helpful. Below is an example of what I need.

FROM THIS:
[TABLE="width: 583"]
<tbody>[TR]
[TD]Name
[/TD]
[TD]Email Address
[/TD]
[TD]Date Received
[/TD]
[TD]Mailing Address if no email
[/TD]
[TD]Comments
[/TD]
[/TR]
[TR]
[TD]Doe, John
[/TD]
[TD]jdoe@email.com
[/TD]
[TD]10/2/2017
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Doe, Jane
[/TD]
[TD]jdoe@email.com
[/TD]
[TD]10/2/2017
[/TD]
[/TR]
</tbody>[/TABLE]


TO THIS:
[TABLE="width: 583"]
<tbody>[TR]
[TD]First Name
[/TD]
[TD]Last Name
[/TD]
[TD]Email
[/TD]
[TD]Date Received
[/TD]
[TD]Mailing Address[/TD]
[/TR]
[TR]
[TD]John & Jane
[/TD]
[TD]Doe
[/TD]
[TD]jdoe@email.com
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[TD]Thanks again!

[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[Dryver14]

OK this assumes second name in A first name in B email address in C

Test on a copy

Sub KWCombineAll()


Dim i As Long
Dim Lastrow As Long


Lastrow = Cells(Rows.Count, 3).End(xlUp).Row


For i = Lastrow To 2 Step -1
    If Cells(i, 3).Offset(-1, 0) = Cells(i, 3) Then
    
        Cells(i - 1, 2) = Cells(i - 1, 2).Value & " & " & Cells(i, 2)
        Cells(i, 2).EntireRow.Delete
        
    End If
    
Next i


End Sub

 

[Justijb]

Works like a charm. Really appreciate your help. Have a great day!

 

[Dryver14]

No worries, Thanks.