Delete Duplicate Rows Using Union Of Ranges
The example below illustrates how to remove duplicate rows where Column A values are identical. This example accumulates all the rows to delete in a range variable, and then deletes tham all at once.
Program Code
Option Explicit
Public Sub DeleteUnionOfRows()
Dim rngSearchRange As Range
Dim LastValue As String
Dim C As Range
Dim DeleteRange As Range
' ***********************************************************
' Search For Duplicates in A1 Through A4000
' ***********************************************************
Set rngSearchRange = Range(Cells(1, 1), Cells(4000, 1))
LastValue = "*****"
For Each C In rngSearchRange
If C.Value = LastValue Then
' ***********************************************************
' Build A Range Variable With All The Duplicate Rows
' ***********************************************************
If DeleteRange Is Nothing Then
Set DeleteRange = Rows(C.Row)
Else
Set DeleteRange = Union(DeleteRange, Rows(C.Row))
End If
End If
LastValue = C.Value
Next C
' ***********************************************************
' Delete All Duplicates At One Time
' ***********************************************************
DeleteRange.Delete
End Sub
Delete Duplicate Rows Using Advanced Features (Excel 2007 and Above)
The following code is compliments of Siddharth Rout
from the Microsoft Excel Developer's forum. It copies the contents of sheet1 to sheet2 (so as to leave sheet1 in its original format), and then creates a formula which combines the contents of two columns (the keys we want to keep unique), propogates the formula through the total number of rows, then converts the formulas to actual values, and finally uses the .RemoveDuplicates method to remove the duplicates.
Sub RemoveDupsSiddharth()
Dim ws As Worksheet, ws1 As Worksheet
Dim LastRow As Long
Set ws = Sheets("Sheet1"): Set ws1 = Sheets("Sheet2")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("A1:C" & LastRow).Copy ws1.Range("A1")
With ws1
.Range("D1") = "Temp"
.Range("D2").FormulaR1C1 = "=RC[-3]&RC[-2]"
.Range("D2").AutoFill Destination:=.Range("D2:D" & LastRow)
.Range("D2:D" & LastRow).Copy
.Range("D2:D" & LastRow).PasteSpecial xlPasteValues
.Range("$A$1:$D$" & LastRow).RemoveDuplicates Columns:=4, Header:=xlYes
.Columns("D:D").ClearContents
End With
End Sub
