Remove Duplicates VBA Code

alforc17

New Member
Joined
Aug 7, 2015
Messages
6
I have the following code, but it is not working. Any ideas?

Sub deleteduplicates()
Dim lastrow As Long
lastrow = Sheets("CategoryMaster").Range("A" & Rows.Count).End(xlUp).row
Sheets("CategoryMaster").Range("A1" & ":" & "G" & lastrow).CurrentRegion.RemoveDuplicates _ Columns:=1, Header:=xlYes
End Sub
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Maybe:
Code:
Sub deleteduplicates()
Dim lastrow As Long
lastrow = Sheets("CategoryMaster").Range("A" & Rows.Count).End(xlUp).Row
Sheets("CategoryMaster").Range("A1:G" & lastrow).RemoveDuplicates _
Columns:=1, Header:=xlYes
End Sub
 
Upvote 0
It's still not working :/ It doesn't do anything at all when I run it.

EDIT:
I realized that it is removing the contents of that duplicate without deleting the entire row and shifting everything else up, and it ends after removing just a few. It doesn't go through the entire sheet.

Thank you for your help!
 
Last edited:
Upvote 0
Yes there are duplicates in column A.

I realized that it is removing the contents of that duplicate without deleting the entire row and shifting everything else up, and it ends after removing just a few. It doesn't go through the entire sheet.
 
Upvote 0
I figured out that there were blank rows in my data that weren't there before. Perhaps the code was creating those blanks??

Anyway, the duplicates code does not work if there are blank rows in the data set. Does anyone know why?
 
Upvote 0
I figured out that there were blank rows in my data that weren't there before. Perhaps the code was creating those blanks??

Anyway, the duplicates code does not work if there are blank rows in the data set. Does anyone know why?
You are more likely to get an answer if you post some sample data and explain what you want to accomplish. At this point, only you know what your data layout looks like before you run the code and what you want it to look like after the code runs.
 
Upvote 0
If you want to use Excel's RemoveDuplicates, then first consider that it may not be very reliable.
Here's some sample data you can try it for a check.
HDR1HDR2
9c9
99
10c10
109
10c10

<tbody>
</tbody>

The red lines appear to be, and are, duplicates whether you're looking at the first column or all columns.
You can check they are indeed duplicates (i.e. I that haven't hidden any non-visible characters) by manually typing them yourself or by using say Advanced Filter which does remove the duplicates that RemoveDuplicates doesn't.
At the least, RemoveDuplicates needs independent verification to check that it is working, but in that case why not just use the independent verification.
There do exist a variety of other methods for reliably removing duplicates.
 
Upvote 0
There are actually real problems with the "Remove Duplicates" function in Excel. With large datasets or other slight challenges the built-in function breaks down and won't actually remove all the duplicates. If you search online for this issue you'll see it's been an issue in Excel for an extremely long time in all versions...even reported to Microsoft.

So I took matter into my own hands. I wrote VBA code to do it. It works how it SHOULD and the same way that the built-in function would...make sure you are aware how your data is sorted before you run the code. For me I sorted everything by date to keep the most recent rows of data and remove the rest...you can sort how you want but keep in mind that the FIRST record is sees, it will compare to the rest and remove any matching rows based on your criteria.
You can add/remove the sStringRef and the sStringChk variable depending on what you want to compare to identify the duplicate rows. Also make sure to Dim the variables to matching types, otherwise won't work as expected.

I tested it today and although it takes a long time to run it does exactly what is expected which is more that what the MS built-in function does!!!

Code:
Public Sub Compare()Dim iCount As Double
Dim iRowCount As Double
Dim iRefRow As Double
Dim iRefCol As Integer
Dim iRow As Double
Dim iCol As Integer


Dim sStringRef1 As String
Dim sStringRef2 As Boolean
Dim sStringRef3 As Boolean
Dim sStringRef4 As Boolean
Dim sStringRef5 As Boolean
Dim sStringRef6 As Boolean
Dim sStringRef7 As Boolean
Dim sStringRef8 As Boolean
Dim sStringRef9 As Boolean


Dim sStringChk1 As String
Dim sStringChk2 As Boolean
Dim sStringChk3 As Boolean
Dim sStringChk4 As Boolean
Dim sStringChk5 As Boolean
Dim sStringChk6 As Boolean
Dim sStringChk7 As Boolean
Dim sStringChk8 As Boolean
Dim sStringChk9 As Boolean


iRow = 2
iCol = 1
iRefCol = 4
iRefRow = 0
iCount = 0
iRowCount = 0


Application.ScreenUpdating = True
'Count number of rows
Do Until Cells(iRow, iCol) = ""
    DoEvents
    iRowCount = iRowCount + 1
    iRow = iRow + 1
Loop
iRow = 2    'Reset index row


Application.ScreenUpdating = False
'Loop through all rows based on row count
For iCount = 2 To iRowCount
    DoEvents
    iRefRow = iCount
    'Assign Strings to reference variables (to check for duplicates)
    sStringRef1 = Cells(iRefRow, iRefCol)
    sStringRef2 = Cells(iRefRow, iRefCol + 1)
    sStringRef3 = Cells(iRefRow, iRefCol + 2)
    sStringRef4 = Cells(iRefRow, iRefCol + 3)
    sStringRef5 = Cells(iRefRow, iRefCol + 4)
    sStringRef6 = Cells(iRefRow, iRefCol + 5)
    sStringRef7 = Cells(iRefRow, iRefCol + 6)
    sStringRef8 = Cells(iRefRow, iRefCol + 7)
    sStringRef9 = Cells(iRefRow, iRefCol + 8)
   
    'Get ready to check the next rows...
    iRow = iRefRow + 1
    
    'Keep checking and comparing all the other rows to the reference row above.
    Do Until Cells(iRow, iCol) = ""
        Application.StatusBar = "Checking Row: " & iRefRow & " ... against Row: " & iRow
        
        DoEvents
        sStringChk1 = Cells(iRow, iRefCol)
        sStringChk2 = Cells(iRow, iRefCol + 1)
        sStringChk3 = Cells(iRow, iRefCol + 2)
        sStringChk4 = Cells(iRow, iRefCol + 3)
        sStringChk5 = Cells(iRow, iRefCol + 4)
        sStringChk6 = Cells(iRow, iRefCol + 5)
        sStringChk7 = Cells(iRow, iRefCol + 6)
        sStringChk8 = Cells(iRow, iRefCol + 7)
        sStringChk9 = Cells(iRow, iRefCol + 8)
        'Compare all variables, if all match then remove the row being checked.
        If sStringChk1 = sStringRef1 And sStringChk2 = sStringRef2 And sStringChk3 = sStringRef3 And sStringChk4 = sStringRef4 And sStringChk5 = sStringRef5 And sStringChk6 = sStringRef6 And sStringChk7 = sStringRef7 And sStringChk8 = sStringRef8 And sStringChk9 = sStringRef9 Then
            Rows(iRow).Select
            Selection.Delete Shift:=xlUp
        End If
        iRow = iRow + 1
    Loop
Next
Application.ScreenUpdating = True
Application.StatusBar = "Ready"
MsgBox "Done!"


End Sub
 
Upvote 0
Welcome to the MrExcel board!


It works how it SHOULD and the same way that the built-in function would
.. it does exactly what is expected which is more that what the MS built-in function does!!!
I completely agree that the built-in Remove Duplicates is unreliable - clearly demonstrated by kalak above, but your claims are considerable!

Perhaps I'm not understanding the use of your code but it does not seem to allow flexibility of where the data is placed or selecting which columns should be used to determine duplicates.

In any case here are a couple of examples to test your code on.

I would have thought that remove duplicates on this sheet should remove rows 5 & 6 - but it only removes one of them.

Excel Workbook
ABCDE
1HDR1HDR2HDR3HDR4HDR5
2xxx9c9
3xxx99
4xxx10c10
5xxx10c10
6xxx10c10
Test1




Remove duplicates should remove rows 6:10 from this sheet? Your code doesn't remove any.

Excel Workbook
ABCDE
1HDR1HDR2HDR3HDR4HDR5
2xxx9c9
3xxx99
4xxx10c10
5xx109
6xxx10c10
7xxx10c10
8xxx10c10
9xxx10c10
10xxx10c10
11
Test2
 
Upvote 0

Forum statistics

Threads
1,215,332
Messages
6,124,314
Members
449,153
Latest member
JazzSingerNL

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top