Remove Duplicate Emails

[Blessy Clara]

Hi All,

Could someone please help me with the following
I have a excel sheet of Emails -
The Columns Run from 1 to 150
In a row sometimes there are multiple occurrence of email
Example bjack4@eq.edu.au
Can be found in Col 3 / Col 60 and Col 120 - I want to retain only one email and remove the duplicate/Multiple occurrences

Col1	Col2	col...	Col	Col120	Col150
djmar2@eq.edu.au		djmar2@eq.edu.au		djmar2@eq.edu.au
	jbrow1200@eq.edu.au				jbrow1200@eq.edu.au

<tbody>
</tbody>

Result required

Col1	Col2	col...	Col	Col120	Col150
djmar2@eq.edu.au
	jbrow1200@eq.edu.au

<tbody>
</tbody>

Thank You

 

[wrightyrx7]

Could make a copy of the workbook then put this in the Worksheets code and run it. I looks in the row for any values that contain an @ then checks the rest of the row for duplicates, if it finds one it gets rid of it. Then once a row is complete moves onto the next one.

Sub test()
Dim c As Long, r As Long, lrow As Long, i As Long
Dim strEmail As String


lrow = 0
For c = 1 To 150 Step 1
    If Cells(Rows.Count, c).End(xlUp).Row > lrow Then
        lrow = Cells(Rows.Count, c).End(xlUp).Row
    End If
Next c


For r = 2 To lrow Step 1
    For c = 1 To 150 Step 1
        If InStr(Cells(r, c).Value, "@") > 0 Then
            strEmail = Cells(r, c).Value
            For i = c + 1 To 150 Step 1
                If Cells(r, i).Value = strEmail Then
                    Cells(r, i).Value = ""
                End If
            Next i
            strEmail = ""
        End If
    Next c
Next r
End Sub

This is assuming you do in fact have 150 columns and the top row is headers.

 

[Blessy Clara]

Hi wrightyrx7

Thank you very much for your time and efforts - Yes - Your assumptions are correct and I got the perfect result