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
- 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