PDA

View Full Version : [SOLVED] Removing Duplicates for Multiple Columns independently



NukedWhale
08-06-2012, 06:34 PM
Hello,

I have several hundred columns of data, with headers. My headers are in row 1, and my data begins on row 2. I would like to remove duplicates for each column independent of one another.

Speaking in pseudo code, a macro might...


For each column in selected range
Dedupe the column
Next Column

Can you help me translate this into VBA code?

Thanks,
NW

patel
08-06-2012, 08:44 PM
attach please a sample, before and after

NukedWhale
08-06-2012, 08:52 PM
Hi Patel,

Example attached.

patel
08-07-2012, 04:00 AM
Sub m()
Application.ScreenUpdating = False
LR = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A2:A" & LR).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("E2"), Unique:=True
Range("B2:B" & LR).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("F2"), Unique:=True
Range("C2:C" & LR).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("G2"), Unique:=True
Application.ScreenUpdating = True
End Sub

NukedWhale
08-07-2012, 10:58 AM
Hi Patel,

Two comments..I need a macro that will perform the removal of duplicates for a selected range and ideally replace the original list with the deduped list.

Thanks,
NW

Kenneth Hobs
08-07-2012, 12:24 PM
Sub NoDupColumnData()
Dim LR As Long, c As Range, cNum As Integer, r As Range, a() As Variant
Application.ScreenUpdating = False
For Each c In Selection.Columns
cNum = c.Column
LR = Cells(Rows.Count, cNum).End(xlUp).Row
Set r = Range(Cells(2, cNum), Cells(LR, cNum))
a() = UniqueValues(r)
r.Clear
r.Resize(UBound(a), 1).Value = WorksheetFunction.Transpose(a)
Next c
Application.ScreenUpdating = True
End Sub

Public Function UniqueValues(theRange As Range) As Variant
Dim colUniques As New VBA.Collection
Dim vArr As Variant
Dim vCell As Variant
Dim vLcell As Variant
Dim oRng As Excel.Range
Dim i As Long
Dim vUnique As Variant
Set oRng = Intersect(theRange, theRange.Parent.UsedRange)
vArr = oRng
On Error Resume Next
For Each vCell In vArr
If vCell <> vLcell Then
If Len(CStr(vCell)) > 0 Then
colUniques.Add vCell, CStr(vCell)
End If
End If
vLcell = vCell
Next vCell
On Error GoTo 0
ReDim vUnique(1 To colUniques.Count)
For i = LBound(vUnique) To UBound(vUnique)
vUnique(i) = colUniques(i)
Next I
UniqueValues = vUnique
End Function

NukedWhale
08-07-2012, 01:40 PM
Thank you Kenneth!

Jekenna
10-17-2012, 09:10 AM
Is there a way to modify this code so that it identifies duplicates based on the cells in column A, but actually copies and replaces the entire ROW of data instead of just the individual cells in column A?

grose456
01-14-2017, 07:07 AM
Is there a way to do this for data in 400+ columns and paste on a separate sheet without having to retype code for multiple columns. (PS: totally new to writing code)

gmaxey
01-14-2017, 08:45 AM
Wouldn't something like this work:


Sub NoDupColumnData()
Dim oSheet As Worksheet
Dim oRng As Rang
ThisWorkbook.Sheets(1).UsedRange.Copy 'Whatever sheet has your 400 columns
Set oSheet = ThisWorkbook.Sheets.Add
oSheet.Name = "Filtered"
oSheet.Paste
Application.ScreenUpdating = False
For Each oRng In oSheet.UsedRange.Columns
oRng.RemoveDuplicates Columns:=Array(1), Header:=xlYes
Next oRng
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub

snb
01-14-2017, 09:08 AM
Advancedfilter has been designed for exactly that purpose.

gmaxey
01-14-2017, 09:13 AM
Instead of trying to dazzle with your infinite advanced knowledge, why don't you show the questioner how AdvancedFilter is used for that purpose?

snb
01-14-2017, 01:04 PM
I meant advancedfilter, not advancedknowledge.