Thread: Merging two contacts files

Cut and paste your second file into the first file so long as the formats (columns) are the same. Next copy this code into your vba editor.

Put your cursor on the first cell containing the name.
Run the code and it will eliminate all duplicates. Be sure you have back up copies first in case you have a problem.

Sub DeleteDuplicateRows()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteDuplicateRows
' This will delete duplicate records, based on the Active Column. That is,
' if the same value is found more than once in the Active Column, all but
' the first (lowest row number) will be deleted.
'
' To run the macro, select the entire column you wish to scan for
' duplicates, and run this procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim r As Long
Dim n As Long
Dim V As Variant
Dim rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Set rng = Application.Intersect(ActiveSheet.UsedRange, _
                    ActiveSheet.Columns(ActiveCell.Column))

Application.StatusBar = "Processing Row: " & Format(rng.Row, "#,##0")

n = 0
For r = rng.Rows.Count To 2 Step -1
If r Mod 500 = 0 Then
    Application.StatusBar = "Processing Row: " & Format(r, "#,##0")
End If

V = rng.Cells(r, 1).Value
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Note that COUNTIF works oddly with a Variant that is equal to vbNullString.
' Rather than pass in the variant, you need to pass in vbNullString explicitly.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If V = vbNullString Then
    If Application.WorksheetFunction.CountIf(rng.Columns(1), vbNullString) > 1 Then
        rng.Rows(r).EntireRow.Delete
        n = n + 1
    End If
Else
    If Application.WorksheetFunction.CountIf(rng.Columns(1), V) > 1 Then
        rng.Rows(r).EntireRow.Delete
        n = n + 1
    End If
End If
Next r

EndMacro:

Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Duplicate Rows Deleted: " & CStr(n)


End Sub