CODEWITHSUNDEEP
vbaexcel
medwatt
medwatt

Reputation: 103

Cannot remove duplicates from range

I have an excel table with several columns two of which I am interested in. What I am trying to do is filter the first column with a specific criterion and then copy the visible values from the other column into a range object. After that I need to remove duplicates. The problem is I get an error. Here's the code. There are a lot of duplicates. Please tell me what's wrong or suggest a better way to achieve the task I'm trying to do.

Sub Begin()

Dim tbl As ListObject
Set tbl = Worksheets("Sheet1").ListObjects("Table1")

WorkSheet.AutoFilterMode = False
tbl.Range.AutoFilter Field:=8, Criteria1:="DUKESTREET_II-2"

Dim rng1 As Range
Set rng1 =  tbl.ListColumns("TGT CELL NAME").DataBodyRange.SpecialCells(xlCellTypeVisible)
MsgBox rng1.Count
rng1.RemoveDuplicates Columns:=1, Header:=xlNo
MsgBox rng1.Count

End Sub

Upvotes: 0

Views: 1067

Answers (2)

user7330156
user7330156

Reputation:

My own solution to this old post below, in case anybody struggle again with that.
Note that I translated my working code into the posted one without testing, but I guess the idea is simple enough to be applied anyway.

Sub Begin()


Dim tbl As ListObject
Set tbl = Worksheets("Sheet1").ListObjects("Table1")

WorkSheet.AutoFilterMode = False
tbl.Range.AutoFilter Field:=8, Criteria1:="DUKESTREET_II-2"
' Sort to make sure filtered view will be contiguous
tbl.range.sort Key1:=tbl.range.cells(1,8), Order1:=xlAscending, Header:=xlYes

Dim rng1 As Range
Set rng1 =  tbl.ListColumns("TGT CELL NAME").DataBodyRange.SpecialCells(xlCellTypeVisible)
MsgBox rng1.Count
' Using Areas(1) does the trick (there is only 1 area - no gaps - thanks to sorting)
rng1.Areas(1).RemoveDuplicates Columns:=1, Header:=xlNo
MsgBox rng1.Count

End Sub

Upvotes: 0

Dan Wagner
Dan Wagner

Reputation: 2713

You're off to a great start, but unfortunately as @siddharth-rout pointed out .RemoveDuplicates will not work on a non-contiguous range.

In this case, to collect the all the unique cell values from the "TGT CELL NAME" column, you could use a collection (MSDN link):

start

Sub Begin()

Dim tbl As ListObject
Dim rng1 As Range, RngIdx As Range
Dim MySheet As Worksheet
Dim UniqueTGTCells As Collection

Set MySheet = ThisWorkbook.Worksheets("Sheet1")
Set tbl = MySheet.ListObjects("Table1")

'only turn off auto filter mode if it's already set to true
If MySheet.AutoFilterMode = True Then
    MySheet.AutoFilterMode = False
End If

tbl.Range.AutoFilter Field:=8, Criteria1:="DUKESTREET_II-2"

Set rng1 = tbl.ListColumns("TGT CELL NAME").DataBodyRange.SpecialCells(xlCellTypeVisible)
MsgBox rng1.Count

'populate the collection object
Set UniqueTGTCells = New Collection
For Each RngIdx In rng1
    On Error Resume Next
    UniqueTGTCells.Add LCase(CStr(RngIdx.Value)), LCase(CStr(RngIdx.Value))
    On Error GoTo 0
Next RngIdx

'message the size of the collection
MsgBox UniqueTGTCells.Count

End Sub

Here are our message boxes:

msg

Upvotes: 1

Related Questions