Delete duplicate entries in excel 2003 vba column

Question

Well, the question is that I have a column, for example, column Y has many records in it, about 40,000, and it grows every time. The thing is, I have to check for duplicates in column Y and delete the whole row. Thus, column Y should only have unique records.

Suppose I have 3000 records, and after 1 week I will have about 3500 records. Now I have to check these newly added 500 column values, not 3500 with old + new ie 3500 records and delete the duplicate row. Old 3000 should not be deleted or changed. I found macros, but they do the trick for the entire column. I would like to filter out the new 500 values.

Cells(2, "Q").Formula = "=COUNTIF(P$1:P1,P2)=0" 'I have used these formula Range("Q2").Copy Destination:=Range("Q3:Q40109") 'it gives false for the duplicate values 

I know that we should use countif for duplicate entries. But what I do is apply the formula, and then search for the false entries and then delete them. I believe that you apply the formula and find the lie, and then remove it a little time.

 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 

This is what I found on google, but I do not know where the error is. It removes all columns if I set

 For x = LastRow To 1 Step -1 For x = LastRow to step 3000 ' It is deleting all 500 columns but if it is -1 working fine 

Any changes must be made to these functions? or I really liked any good feature that helps me. Check for duplicate values ​​for the selected range of columns from the entire column. I mean, check 500 queries the column values ​​with the record values ​​of column 3500 and removes duplicates of 500 records.

Thank you in advance

Answer 1

It should be pretty simple. You need to create 1 cell somewhere in your file that you will record the number of cells for column Y every week after deleting all the cheats.

For example, say, week1, you remove the trompe l'oeil, and you are left with a range of Y1: Y100. Your function will put “100” somewhere in your file for reference.

Next week, your function will start looking for a bypass from (cell number ref) + 1, so Y: 101 to the end of the column. After removing duplicates, the function changes the ref cell to a new account.

Here is the code:

 Sub RemoveNewDupes() 'Initialize for first time running this If Len(Range("A1").Value) = 0 Then Range("A1").Value = Range("Y" & Rows.count).End(xlUp).row End If If Range("A1").Value = 1 Then Range("A1").Value = 0 'Goodbye dupes! ActiveSheet.Range("Y" & Range("A1").Value + 1 & ":Y" & _ Range("Y" & Rows.count).End(xlUp).row).RemoveDuplicates Columns:=1, Header:=xlNo 'Re-initialize the count for next time Range("A1").Value = Range("Y" & Rows.count).End(xlUp).row End Sub 

* Sorry, I don’t know why auto-syntax highlighting makes this difficult to read.

Update

Here's how to do it in Excel 2003. The trick is to scroll backward through the column so that the loop will not be destroyed when the row is deleted. I use a dictionary (which I am famous for its excessive use), as it makes it easy to check for cheats.

 Sub RemoveNewDupes() Dim lastRow As Long Dim dict As Object Set dict = CreateObject("scripting.dictionary") If Len(Range("A1").Value) = 0 Then Range("A1").Value = 1 End If lastRow = Range("Y" & Rows.count).End(xlUp).row On Error Resume Next For i = lastRow To Range("A1").Value Step -1 If dict.exists(Range("Y" & i).Value) = True Then Range("Y" & i).EntireRow.Delete End If dict.Add Range("Y" & i).Value, 1 Next Range("A1").Value = Range("Y" & Rows.count).End(xlUp).row End Sub 

Answer 2

How can Excel know that records are "new"? (for example, how can we know that we should only consider the last 500 lines)
In fact, if you already ran the macro last week, the first 3000 lines will not have duplicates, so the current execution will not change these lines.

The code described above should work. If we save it and change it a little:

 Sub DeleteDups() Dim x As Long Dim LastRow As Long LastRow = Range("Q65536").End(xlUp).Row For x = LastRow To 1 Step -1 'parse every cell from the bottom to the top (to still count duplicates) ' and check if duplicates thanks to the formula If Range("Q" & x).Value Then Range("Q" & x).EntireRow.Delete Next x End Sub 

---

[EDIT] Another (possibly faster) solution: first filter the values ​​and then delete the visible lines:

 Sub DeleteDups() ActiveSheet.UsedRange.AutoFilter Field:=17, Criteria1:="True" 'filter column Q for True values ActiveSheet.Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete End Sub 

Failed to check this last solution right here, sorry.

Answer 3

Here is an idea:

 Sub test LastRow = Range("A65536").End(xlUp).Row For i = LastRow To 1 Step -1 If Not Range("a1:a" & whateverLastRowYouWantToUse ).Find(Range("a" & i).Value, , , , , xlPrevious) Is Nothing Then Rows(i).Delete End If Next i End Sub 

It checks the entire range above the current cell for a single duplicate. If found, the current line will be deleted.

EDIT I just realized in your example, you said the column is Y, but in your code you check A. Not sure if the example was just hypothetical, but wanted to make sure t the reason for the odd behavior.

Please note that this is not verified! Save your book before trying to do this.