How do I build a macro to find duplicate email addresses in a spreadsheet then append data to another cell?

Hi,

I was wondering if someone could help me. I have recieved a large spreadsheet with the following
column headers: NUMBER, FIRSTNAME, LASTNAME, EMAIL and I need to create macro to do the following
tasks.

FOR every row:

1) If the email address is the same as the email address in the cell above then take the value
of the NUMBER cell (off the same row) and append it to the value of the NUMBER cell above.
Then delete the row that you just copied the NUMBER value from.

So for example:

BEFORE Macro is ran:

NUMBER     FIRSTNAME     LASTNAME     EMAIL
12345      JOHN          DOE           DEMO@DEMO.COM
67891      BOB            EVAN         DEMO@DEMO.COM
 
AFTER Macro is ran:

NUMBER             FIRSTNAME          LASTNAME         EMAIL
12345,67891     JOHN                     DOE                     DEMO@DEMO.COM

I hope that makes sense.

Thank you in advance for any help.
r00tdanAsked:
Who is Participating?
 
tigermattConnect With a Mentor Commented:
Something like this?

-Matt
Sub EmailLoop()
    For i = 2 To Range("D" & ActiveSheet.Rows.Count).End(xlUp).Row Step 1
        If (LCase(Range("D" & i).Value) = LCase(Range("D" & (i - 1)).Value)) Then
            
            Range("A" & (i - 1)).Value = Range("A" & (i - 1)).Value & "," & Range("A" & i).Value
            Rows(i).EntireRow.Delete
            
        End If
    Next
End Sub

Open in new window

0
 
Saurabh Singh TeotiaCommented:
I designed a udf long time back...and it basically works same as vlookup..the only difference is..it combines all the matching values to one cell...
Enclosed is the file with udf for your reference...
Saurabh...

mylookup.xls
0
 
SpajeolyCommented:
I did it this way at one point..... In code, you can use the Filter functions or even a Pivot Table to do it without code.
For i = 1 to 65536

Open in new window

0
 
SpajeolyCommented:
Ok, let me try that again. I think this works, not tested....
For i = 1 to 65536
  if range("$D$" & i + 1).value == "" Then exit for
    for x = I + 1 to 65536
      if range("$D$" & x).Value = Range("$D$" & i).Value then
        Range("$A$" & i).Value = Range("$A$" & i).Value & " - " & Range("$A$" & x).Value 
        Range("$A$" & x).EntireRow.Delete
      End If
    Next
Next

Open in new window

0
 
r00tdanAuthor Commented:
Thank you! Really appreciate your time!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.