Remove duplicates vba excel 2003 [SOLVED]

[looney]

Hi!


For 2010 there is this piece of removing duplicates


ws.Range("A2:A" & lr2).RemoveDuplicates Columns:=1, Header:=xlNo


Now I need it for 2003 but it does not seem to work for me.

[pre]

Dim r As Range,n As Long, a()
Redim a(1 To lr2 - 1, 1 To 1)
With Createobject("Scripting.Dictionary")
.CompareMode = 1
For Each r In ws.Range("A2:A" & lr2)
If Not .Exists(r.Value) Then
n = n + 1
a(n, 1) = r.Value
.Item(r.Value) = Empty
End If
Next
End With
ws.Range("A2:A" & lr2).Value = a

[/pre]
I have an example file here https://www.dropbox.com/s/dlpniwa3h096zun/sampleremdub.xls


Can someone help me out with this?

 

[NARAYANK991]

Hi ,


It should work provided you define lr2 and ws ; lr2 is the number of the last row of data ; in your example worksheet , if the last row of data is row 6 , put lr2 to 6.


ws should also be defined ; in the absence of a definition , replace ws by Activesheet.


Try this :

[pre]

Sub removedub()
Dim r As Range, n As Long, a()
lr2 = 9     ' define lr2 as the last row of data
ReDim a(1 To lr2 - 1, 1 To 1)
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For Each r In ActiveSheet.Range("T2:T" & lr2)
If Not .Exists(r.Value) Then
n = n + 1
a(n, 1) = r.Value
.Item(r.Value) = Empty
End If
Next
End With
ActiveSheet.Range("T2:T" & lr2).Value = a
End Sub

[/pre]
Of course , I have Excel 2007 , so I cannot be absolutely sure that this will work in Excel 2003 , but if you can try and report back on any error messages , we can troubleshoot.


Narayan

 

[looney]

Sweet! Thanks Narayan! It seems to do the trick!


I have made a little modification on the last row.

[pre]

Sub removedub2()
Dim r As Range, n As Long, a()
lr2 = Range("T" & Rows.Count).End(xlUp).Row     ' define lr2 as the last row of data
ReDim a(1 To lr2 - 1, 1 To 1)
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For Each r In ActiveSheet.Range("T2:T" & lr2)
If Not .Exists(r.Value) Then
n = n + 1
a(n, 1) = r.Value
.Item(r.Value) = Empty
End If
Next
End With
ActiveSheet.Range("T2:T" & lr2).Value = a
End Sub

[/pre]

 

[shrivallabha]

Dictionary itself is associative array so you don't need one more array to hold data. This should work as well.


@Narayan: Dictionary comes from Scripting Runtime [scrrun.dll] so it will work in 2003 just as fine as it'd in 2007. Refer to JW's links at the end of this post:

http://chandoo.org/forums/topic/vba-run-a-loop-into-another-loop

[pre]

Sub removedub2()
Dim r As Range
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For Each r In Range("T2:T" & Range("T" & Rows.Count).End(xlUp).Row)
If Not .Exists(r.Value) Then
.Add r.Value, r.Value
End If
Next
Range("T2:T" & Range("T" & Rows.Count).End(xlUp).Row).Delete xlUp
Range("T2").Resize(.Count, 1) = Application.Transpose(.keys)
End With
End Sub

[/pre]

 

[jeffreyweir]

Also note that if the range being deduped is large, then it will be much faster to pull the range into VBA via a variant array then loop through the variant within VBA, rather than looping through the range on the worksheet.


Let us know if your dataset IS large, because this is much faster. There's some comments re this at the end of this very long post on a linkedin group (that you have to register for, but is quite a good group):

http://www.linkedin.com/groupAnswers?viewQuestionAndAnswers=&discussionID=221073497&gid=58704&commentID=147758309&trk=view_disc&fromEmail=&ut=3e1yCO17K7hBQ1


At that forum, I found that my pc deduped 200,000 random integers between 1 and 99,999 using a dictionary in 1 second when the data was pulled into VBA via a variant, vs 14 seconds for the case where the code instead looped through a range as per your code above.