Deleting matching data

[Eric Kelcher]

I have a file that combines multiple years data to generate a mailing list. I want only one mailing going and I want it to be the most recent data here is sample of the file

08 license mailing list with 03 SO.xls
	A	B	C	D	E	F	G	H	I
998	645686	5/22/2006	SR	AM	29	CHRIS	CONLEY	2924WEISMANRD	WHEATON
999	645686	7/23/2007	SR	AM	104	CHRIS	CONLEY	2924WEISMANRD	WHEATON
1000	606737	1/22/2007	NE	EX	481	PAUL	CONLEY	24WALNUTSTAPTC	MAYNARD
1001	827686	5/2/2005	NV	AM	415	STEVEN	CONLY	41CHISSEYRD.	AVON
1002	504187	1/3/2007	MA	AM	519	MICHAEL	CONNER	2711FORTBAKERDRSE#1	WASHINGTON
1003	506898	3/31/2003	CM	AM	130	PHILLIP	CONNER	11409JANUARYDR.	AUSTIN
1004	721708	5/7/2007	NV	AM	216	ERIC	CONNOLLY	17JAFFARIANRD	HAVERHILL
1005	588587	2/8/2007	NE	AM	165	MARK	CONNOLLY	7WESTST	CHERRYVALLEY
1006	588587	7/5/2005	NV	AM	165	MARKE.	CONNOLLY	7WESTST.	CHERRYVALLEY
1007	681982	3/22/2006	GL	AM	42	JAMES	CONNOR	5259E77THSTREET	INDIANAPOLIS
1008	742996	9/14/2005	NV	AM	704	JOYCE	CONOR	162ROSLINDALEAVE	BOSTON
1009	661836	9/14/2005	MW	EX	362	DARREN	CONRAD	24210BROWNLANE	PLAINFIELD
1010	661836	9/16/2006	NL	EX	762	DARREN	CONRAD	24210BROWNLN	PLAINFIELD
1011	217900	5/31/2005	MA	AM	118	CHRIS	COOKE	12261D.PENDERCREEKCIR.	FAIRFAX
1012	217900	11/28/2007	MA	AM	208	CHRIS	COOKE	13164NEWPARKLANDDR	HERNDON
CCSLIST

Where col A is a member number (this is not always entered properly or we could just use it to weed out the previous year info) Here is program I put together to do that but for some reason it does not work very well ie it leaves some that are matching numbers ??? The other issue si a member number may be assigned to another rider in future years so I sort it by name then check the member number.

Sub DuplicateRiderListprt2()
Rem for master mailing list
Range("A1:L9864").Sort Key1:=Range("b1"), Order1:=xlAscending, Key2:= _
Range("G1"), Order2:=xlAscending, Key3:=Range("F1"), Order3:=xlAscending _
, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
Application.ScreenUpdating = False

Dim LR&, LC%, x&
With Range("A1").CurrentRegion
LR = .Rows.Count
LC = .Columns.Count
.Interior.ColorIndex = 0
End With

For x = LR - 1 To 2 Step -1
If Cells(x, 1).Value = Cells(x + 1, 1).Value Then
If Cells(x, 1).Value<> Cells(x - 1, 1).Value Then
Rows(x).Delete

End If
End If
Next x

I then have this program to check first name at an address and remove those duplicates but again it seems to remove only some from the list.

Sub DuplicateRiderList()
Rem for master mailing list
Range("A1:L9864").Sort Key1:=Range("b1"), Order1:=xlAscending, Key2:= _
Range("G1"), Order2:=xlAscending, Key3:=Range("F1"), Order3:=xlAscending _
, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
Application.ScreenUpdating = False

Dim LR&, LC%, x&
With Range("A1").CurrentRegion
LR = .Rows.Count
LC = .Columns.Count
.Interior.ColorIndex = 0
End With

For x = LR - 1 To 2 Step -1
If Cells(x, 6).Value & Cells(x, 8).Value = Cells(x + 1, 6).Value & Cells(x + 1, 8).Value Then
If Cells(x, 6).Value & Cells(x, 8).Value<> Cells(x - 1, 6).Value & Cells(x - 1, 8).Value Then
Rows(x).Delete

End If
End If
Next x
End Sub

As an FYI this list was 11,000 entries and was pared down to 8,000 then 7,790 but I as you can see there are lots of duplicates still.

This has me really confused as it removes some but not others if it totally did not work then that would be one thing

Oh and yes I aware that St and St. are diferent and that I will have to sort those out manually same with Ln vs Lane

 

[jindon]

try

Sub test()
Dim a, i As Long, ii As Integer, b(), n As Long, x
With Activesheet.UsedRange
    a = .Value
    ReDim b(1 To .Rows.Count, 1 To .Columns.Count)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a,1)
            If Not IsEmpty(a(i,1)) Then
                If Not .exists(a(i,1)) Then
                    n = n + 1
                    For ii = 1 To UBound(a,2) : b(n,ii) = a(i,ii) : Next
                    .add a(i,1), n
                Else
                    x = .item(a(i,1))
                    If b(x,2) < a(i,2) Then
                        For ii = 2 To UBound(a,2) : b(x, ii) = a(i,ii)
                    End If
                End If
            End If
        Next
    End With
    .Value = b
End With
End Sub