Deleting Duplicates with VBA Based on Two Columns- Excel 2003 - vba

Question

I'm using Excel 2003 having the following table and want to remove the duplicate rows based on first name and last name if they are the same.
-------------------------------------
| first name | last name | balance |
-------------------------------------
| Alex | Joe | 200 |
| Alex | Joe | 200 |
| Dan | Jac | 500 |
-------------------------------------
so far i have a VB macro that only remove duplicates if the first name is duplicate.
Sub DeleteDups()
Dim x As Long
Dim LastRow As Long
LastRow = Range("A65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
Range("A" & x).EntireRow.Delete
End If
Next x
End Sub
and please advice if it is possible to run this macro once the file opened.thanks in advance

Answer 1

You can use a dictionary to store the values. Any value already existing in the dictionary can be deleted during the iteration as well.
Code:
Sub RemoveDuplicates()
Dim NameDict As Object
Dim RngFirst As Range, CellFirst As Range
Dim FName As String, LName As String, FullName As String
Dim LRow As Long
Set NameDict = CreateObject("Scripting.Dictionary")
With Sheet1 'Modify as necessary.
LRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set RngFirst = .Range("A2:A" & LRow)
End With
With NameDict
For Each CellFirst In RngFirst
With CellFirst
FName = .Value
LName = .Offset(0, 1).Value
FullName = FName & LName
End With
If Not .Exists(FullName) And Len(FullName) > 0 Then
.Add FullName, Empty
Else
CellFirst.EntireRow.Delete
End If
Next
End With
End Sub
Screenshots:
Before running:
After running:
You can call this from a Workbook_Open event to trigger it every time you open the workbook as well.
Let us know if this helps.

Answer 2

Since you're working with Excel 2003, .RemoveDuplicates and COUNTIFs not supported, so you can try this one:
Sub DeleteDups()
Dim x As Long
Dim LastRow As Long
Dim ws As Worksheet
Dim rngToDel As Range
'change sheet1 to suit
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For x = LastRow To 2 Step -1
If Evaluate("=ISNUMBER(MATCH('" & .Name & "'!A" & x & " & '" & .Name & "'!B" & x & ",'" & .Name & "'!A1:A" & x - 1 & " & '" & .Name & "'!B1:B" & x - 1 & ",0))") Then
If rngToDel Is Nothing Then
Set rngToDel = .Range("A" & x)
Else
Set rngToDel = Union(rngToDel, .Range("A" & x))
End If
End If
Next x
End With
If Not rngToDel Is Nothing Then rngToDel.EntireRow.Delete
End Sub
this solution based on the formula =ISNUMBER(MATCH(A100 & B100 ,A1:A99 & B1:B99, 0)) with array entry, which returns TRUE if there're duplicates in rows above and FALSE othervise.
To run this macro just after opening workbook, add next code to ThisWorkbook module:
Private Sub Workbook_Open()
Application.EnableEvents = False
Call DeleteDups
Application.EnableEvents = True
End Sub

Answer 3

It works in excel 2007. Try in 2003 may be it'll help you
Sub DeleteDups()
Sheets("Sheet1").Range("A2", Sheets("Sheet1").Cells(Sheets("Sheet1").Range("A:A").SpecialCells(xlCellTypeConstants).Count, 3)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
End Sub