Advanced autofilter in vba - Can't Get Unique Values

bartrein · Aug 27, 2009

Hi

- I have a table of data in range a1:d20000
- Column "B" contains duplicate & unique values
- I want to delete entire-rows with duplicates in col B
- TO do that i create a temporary sheet,
using ADVANCED autofilter i extract and paste rows with unique values into that sheet, remove original table with duplicates and paste back unique records

So far so good, it works great and quick on large volumes of data except that sometimes it doesn't work

Can't think of any reason why this is happening but i came across the following scenarios :

- my macro works always on one column
- usually works on more columns providing criteria column (the one filtered for unique values) is first (leftmost)
- only sometimes works when criteria column is in between other columns

The last 2 points are really confusing me because i am unable to establish a pattern here.
The source data is a standard table, no blank rows,column b
contains alfanumeric codes e.g 027293247X.LU, i know that
autofilter assumes that column has a header and i'm ok with that. The problem is that sometimes filtering does not happen at all and after this line pasted records are exactly the same (with duplicates):

'''''''''''''''''''''''''''''''''''''''''''''

rngDataTable.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=rngCriteriaColumn, _
CopyToRange:=rngPasteUniqueRecs, _
Unique:=True

''''''''''''''''''''''''''''''''''''''''

Am i missing something obvious here?
Can you good people help me out of my misery?

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Sub test_delDupl()
'
' Macro1 Macro
' Macro recorded 26/8/2009 by bartosz_reinholc
Dim rngTable As Range
Dim rngCriteria As Range
Dim t

t = Timer
Set rngTable = Sheets("source").Range("a1:b1629")
Set rngCriteria = Sheets("source").Range("b1:b1629")

DeleteRows_DUPLICATES rngTable, rngCriteria

Set rngTable = Nothing
Set rngCriteria = Nothing

Debug.Print Timer - t

End Sub

'---------------------------------------------------------------------------------------
' Procedure : DeleteRows_DUPLICATES
' Author :
' Date : 8/26/2009
' Purpose :
'---------------------------------------------------------------------------------------
'
Public Sub DeleteRows_DUPLICATES(rngDataTable As Range, _
rngCriteriaColumn As Range)

On Error GoTo DeleteRows_DUPLICATES_Error

'create new sheet to paste filtered data
Dim shTempSheet As Worksheet
Set shTempSheet = Sheets.Add

'set ref to destination range in the new sheet....
'...where data will be pasted
Dim rngPasteUniqueRecs As Range
Set rngPasteUniqueRecs = shTempSheet.Range("a1")

'check if passed parameters are valied excel ranges
If rngDataTable Is Nothing _
Or rngCriteriaColumn Is Nothing _
Or rngPasteUniqueRecs Is Nothing Then

MsgBox "Invalid Range", vbCritical, "Error"
Exit Sub
End If

'Use Advance filter to get unique values and paste them into new sheet
rngDataTable.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=rngCriteriaColumn, _
CopyToRange:=rngPasteUniqueRecs, _
Unique:=True

'remove all values from the original range (containing duplicates)
With rngDataTable
.ClearContents
.Value = shTempSheet.UsedRange.Value 'paste filtered unique rows
End With

'delete temp sheet
rngDataTable.Application.DisplayAlerts = False
shTempSheet.Delete
rngDataTable.Application.DisplayAlerts = True

'free memory
Set rngPasteUniqueRecs = Nothing

On Error GoTo 0
Exit Sub

DeleteRows_DUPLICATES_Error:
'free memory
Set rngPasteUniqueRecs = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DeleteRows_DUPLICATES of Module Module1"

End Sub

SkipVought · Aug 27, 2009

Hi,

Here's how to remove duplicates easily.

Put a COUNTIF formula in a helper column. If the returned value is greater than 1, you have a duplicate...
[tt]
=COUNTIF($B$2:B2,B2)
[/tt]
Use AutoFilter to display rows > 1

Select rows & DELETE.

Record a macro if you think you need code.

VOLA y'all!

Skip,
[sub]
[glasses]