Removing duplicates in an array

E

EdStockton

New Member
Joined
Aug 6, 2014
Messages
47
Hello everyone,

I am attempting to remove duplicates in three columns individually. The data is a trial balance on a sheet entitled TB. I am selecting columns A, B, and C and copying those columns to a new sheet called Criteria. Once I get the columns to Criteria, I need to remove the duplicates in each column individually. It works except for the last column. My trial balance is about 500 rows so for my example shown here I will display only a few rows. My code is as follows:

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+z
'
Sheets("Sheet1").Select
Sheets("Sheet1").Copy Before:=Sheets(1)
Sheets("Sheet1 (2)").Select
Sheets("Sheet1 (2)").Name = "Criteria"
Application.GoTo ActiveWorkbook.Sheets("TB").Cells(1, 1)
ActiveSheet.Range("a1", ActiveSheet.Range("a1").End(xlDown)).Select
Selection.Copy
Application.GoTo ActiveWorkbook.Sheets("Criteria").Cells(1, 1)
ActiveSheet.Paste
Application.CutCopyMode = False
Application.GoTo ActiveWorkbook.Sheets("Criteria").Cells(1, 1)
OnlyColumnA
Application.GoTo ActiveWorkbook.Sheets("TB").Cells(1, 2)
ActiveSheet.Range("b1", ActiveSheet.Range("b1").End(xlDown)).Select
Selection.Copy
Application.GoTo ActiveWorkbook.Sheets("Criteria").Cells(1, 2)
ActiveSheet.Paste
Application.CutCopyMode = False
Application.GoTo ActiveWorkbook.Sheets("Criteria").Cells(1, 2)
OnlyColumnB
Application.GoTo ActiveWorkbook.Sheets("TB").Cells(1, 3)
ActiveSheet.Range("c1", ActiveSheet.Range("c1").End(xlDown)).Select
Selection.Copy
Application.GoTo ActiveWorkbook.Sheets("Criteria").Cells(1, 3)
ActiveSheet.Paste
Application.CutCopyMode = False
Application.GoTo ActiveWorkbook.Sheets("Criteria").Cells(1, 3)
OnlyColumnC
End Sub
Sub OnlyColumnA()
Dim n As Long

n = Cells(Rows.Count, "A").End(xlUp).Row
ActiveSheet.Range("A1:A" & n).RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
Sub OnlyColumnB()
Dim m As Long

m = Cells(Rows.Count, "B").End(xlUp).Row
ActiveSheet.Range("B1:B" & m).RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
Sub OnlyColumnC()
Dim p As Long

p = Cells(Rows.Count, "C").End(xlUp).Row
ActiveSheet.Range("C1:C" & p).RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

When I run this, I still have duplicates in column C. The data I am using is of this nature:

[TABLE="width: 238"]
<tbody>[TR]
[TD]Property[/TD]
[TD]PropType[/TD]
[TD]PropNum[/TD]
[/TR]
[TR]
[TD]Bond0000[/TD]
[TD]Bond[/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]OPCP0000[/TD]
[TD]OPCO[/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]OPMA0000[/TD]
[TD]OPMA[/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]CFP0000[/TD]
[TD]CFP[/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]RHF0000[/TD]
[TD]RHF[/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]Bond1001[/TD]
[TD]Bond[/TD]
[TD="align: right"]1001[/TD]
[/TR]
[TR]
[TD]OPCO1001[/TD]
[TD]OPCO[/TD]
[TD="align: right"]1001[/TD]
[/TR]
[TR]
[TD]OPMA1001[/TD]
[TD]OPMA[/TD]
[TD="align: right"]1001[/TD]
[/TR]
[TR]
[TD]CFP1001[/TD]
[TD]CFP[/TD]
[TD="align: right"]1001[/TD]
[/TR]
[TR]
[TD]RHF1001[/TD]
[TD]RHF[/TD]
[TD="align: right"]1001[/TD]
[/TR]
[TR]
[TD]Bond1005[/TD]
[TD]Bond[/TD]
[TD="align: right"]1005[/TD]
[/TR]
[TR]
[TD]OPCO1005[/TD]
[TD]OPCO[/TD]
[TD="align: right"]1005[/TD]
[/TR]
[TR]
[TD]OPMA1005[/TD]
[TD]OPMA[/TD]
[TD="align: right"]1005[/TD]
[/TR]
[TR]
[TD]CFP1005[/TD]
[TD]CFP[/TD]
[TD="align: right"]1005[/TD]
[/TR]
[TR]
[TD]RHF1005[/TD]
[TD]RHF[/TD]
[TD="align: right"]1005[/TD]
[/TR]
[TR]
[TD]Bond1007[/TD]
[TD]Bond[/TD]
[TD="align: right"]1007[/TD]
[/TR]
[TR]
[TD]OPCO1007[/TD]
[TD]OPCO[/TD]
[TD="align: right"]1007[/TD]
[/TR]
[TR]
[TD]OPMA1007[/TD]
[TD]OPMA[/TD]
[TD="align: right"]1007[/TD]
[/TR]
[TR]
[TD]CFP1007[/TD]
[TD]CFP[/TD]
[TD="align: right"]1007[/TD]
[/TR]
[TR]
[TD]RHF1007[/TD]
[TD]RHF[/TD]
[TD="align: right"]1007[/TD]
[/TR]
</tbody>[/TABLE]
<strike></strike>

<strike></strike>When the process is finished it should look like this:

[TABLE="width: 234"]
<tbody>[TR]
[TD]Property[/TD]
[TD]PropType[/TD]
[TD]PropNum[/TD]
[/TR]
[TR]
[TD]Bond0000[/TD]
[TD]Bond[/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]OPCP0000[/TD]
[TD]OPCO[/TD]
[TD="align: right"]1001[/TD]
[/TR]
[TR]
[TD]OPMA0000[/TD]
[TD]OPMA[/TD]
[TD="align: right"]1005[/TD]
[/TR]
[TR]
[TD]CFP0000[/TD]
[TD]CFP[/TD]
[TD="align: right"]1007[/TD]
[/TR]
[TR]
[TD]RHF0000[/TD]
[TD]RHF[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Bond1001[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]OPCO1001[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]OPMA1001[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]CFP1001[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]RHF1001[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Bond1005[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]OPCO1005[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]OPMA1005[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]CFP1005[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]RHF1005[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Bond1007[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]OPCO1007[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]OPMA1007[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]CFP1007[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]RHF1007[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Instead it looks like this:

[TABLE="width: 226"]
<tbody>[TR]
[TD]Property[/TD]
[TD]PropType[/TD]
[TD]PropNum[/TD]
[/TR]
[TR]
[TD]Bond0000[/TD]
[TD]Bond[/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]OPCP0000[/TD]
[TD]OPCO[/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]OPMA0000[/TD]
[TD]OPMA[/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]CFP0000[/TD]
[TD]CFP[/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]RHF0000[/TD]
[TD]RHF[/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]Bond1001[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]OPCO1001[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]OPMA1001[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]CFP1001[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]RHF1001[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]Bond1005[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]OPCO1005[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]OPMA1005[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]CFP1005[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]RHF1005[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]Bond1007[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]OPCO1007[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]OPMA1007[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]CFP1007[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
[TR]
[TD]RHF1007[/TD]
[TD][/TD]
[TD]0000[/TD]
[/TR]
</tbody>[/TABLE]

I would really appreciate your help.

Thanks, Ed
 
Last edited:

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
Try this :-
From sheets "TB" to "Criteria"
Code: 
[COLOR="Navy"]Sub[/COLOR] MG06Jun22
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
Ray = Sheets("Tb").Cells(1).CurrentRegion
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
ReDim nRay(1 To UBound(Ray, 1), 1 To 3)
[COLOR="Navy"]For[/COLOR] ac = 1 To 3
    [COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray, 1)
        Dic(Ray(n, ac)) = Empty
    [COLOR="Navy"]Next[/COLOR]
        [COLOR="Navy"]With[/COLOR] Sheets("Criteria").Cells(1, ac).Resize(Dic.Count)
            .Value = Application.Transpose(Dic.keys)
            .Parent.Range("C:C").NumberFormat = "@"
        [COLOR="Navy"]End[/COLOR] With
        Dic.RemoveAll
[COLOR="Navy"]Next[/COLOR] ac
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Remove duplicates keep formatting
Replies
1
Views
491
Aqusmacro
A
M
  • Solved
VBA Help - Duplicate & Unwanted Data Removal
Replies
6
Views
930
MoonDancer
M
H
  • Solved
problem with code- removing duplicate rows
Replies
2
Views
352
heathball
H
T
  • Question Question
Remove Duplicates with Dynamic Columns Array
Replies
0
Views
659
trough
T
M
  • Question Question
VBA date filter returns blank
Replies
3
Views
516
Micron
M

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top