OzGrid

Excel: Remove Duplicates in Excel

< Back to Search results

 Category: [Excel]  Demo Available 

Excel: Remove Duplicates in Excel

 

Got any Excel/VBA Questions? Free Excel Help 

Remove Duplicates With Advanced Filter

This method of removing duplicates uses Excel's Advanced Filter and is about the fastest method. This example acts on data in Column "A".

Sub RemoveDupes()



	'Add extra Column, "A" becomes "B"

	Columns(1).EntireColumn.Insert

	

	'Filter out duplicates and copy unique list to "A"

	Range("B1", Range("B65536").End(xlUp)).AdvancedFilter _

		Action:=xlFilterCopy, CopyToRange:=Range("A1"), Unique:=True



	'Add extra Column, "B" becomes "A"

	Columns(2).EntireColumn.Delete



End Sub

Note how an extra Column is inserted so that Column "A" becomes Column "B", it is then deleted so all returns to normal. 

Remove Duplicates From Any Range Selection

This method of removing duplicates will work on the selected data.

Sub KillDupes()

Dim rConstRange As Range, rFormRange As Range

Dim rAllRange As Range, rCell As Range

Dim iCount As Long

Dim strAdd As String



	On Error Resume Next

	Set rAllRange = Selection

		If WorksheetFunction.CountA(rAllRange) < 2 Then

			MsgBox "You selection is not valid", vbInformation

      		On Error GoTo 0

      		Exit Sub

		End If





	Set rConstRange = rAllRange.SpecialCells(xlCellTypeConstants)

	Set rFormRange = rAllRange.SpecialCells(xlCellTypeFormulas)



    If Not rConstRange Is Nothing And Not rFormRange Is Nothing Then

		Set rAllRange = Union(rConstRange, rFormRange)

    ElseIf Not rConstRange Is Nothing Then

		Set rAllRange = rConstRange

    ElseIf Not rFormRange Is Nothing Then

		Set rAllRange = rFormRange

    Else

		MsgBox "You selection is not valid", vbInformation

		On Error GoTo 0

		Exit Sub

    End If

   

	Application.Calculation = xlCalculationManual



	For Each rCell In rAllRange

		strAdd = rCell.Address

		strAdd = rAllRange.Find(What:=rCell, After:=rCell, LookIn:=xlValues, _

			LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

			MatchCase:=False).Address

          

		If strAdd <> rCell.Address Then

			rCell.Clear

		End If

	Next rCell



  

	Application.Calculation = xlCalculationAutomatic

	On Error GoTo 0

End Sub

See also:

Prevent Save As in Excel
Prevent Excel Being Saved With Another Name
Prevent Save Prompts in Excel
Excel VBA: Determine Number of Pages to be Printed
Protect/Lock Excel VBA Code
Excel: Generate Unique Random Numbers
Get Range Address of a Excel Named Range

 

See also Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions.

 

Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.


Gallery



stars (0 Reviews)