Excel VBA Video Training/ EXCEL DASHBOARD REPORTS

Excel: Remove Duplicates in Excel

Back to: Excel VBA . Got any Excel/VBA Questions? Free Excel Help See Also: Duplication Manager

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

Excel Dashboard Reports & Excel Dashboard Charts 50% Off Become an ExcelUser Affiliate & Earn Money

Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over $64.00. ALL purchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to [email protected] 31 days after purchase date.

Instant Download and Money Back Guarantee on Most Software

Excel VBA Video Training/ EXCEL DASHBOARD REPORTS

Excel Trader Package Technical Analysis in Excel With $139.00 of FREE software!

Microsoft � and Microsoft Excel � are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft