VBA Code to delete duplicate records excluding records beginning with an Alpha Character

[howard]

I have a spreadsheet that contains duplicate references in Col H. I would like VBA code that will retain either the first or second duplicate, except where the reference begins with an Alpha Character.All references beginning with an Alpha character must be retained

In the example below all the references beginning with an Alpha for eg F14890 must be retained. One of the rows containing the duplicate references for eg 203432/1 must be deleted and the other one retained i.e one unique record must be retained

Your assistance in this regard will be most appreciated

Duplicate Records.xlsx
	A	B	C	D	E	F	G	H
26	10-03-2011	INV	PARTSORDER	30I00223		-6,199.32		203434
27	10-03-2011	PMT	PARTSORDER			453,208.67		F14890
28	10-03-2011	PMT	PARTSORDER			27,118.04		F14890
29	10-03-2011	PMT	PARTSORDER			27,118.04		F14890
30	10-03-2011	INV	PARTSORDER	30I00225		-729.50		203432/1
31	10-03-2011	INV	PARTSORDER	30I00222		-1,286.83		203433/1
32	10-12-2010	JDR	PARTSORDER	8424		8,513.92		8424
33	10-12-2010	JDR	PARTSORDER	8424		8,513.92		8424
34	11-02-2011	INV	PARTSORDER	30I00080		-26,243.49		199979
35	11-02-2011	INV	PARTSORDER	30I00080		-26,243.49		199979
36	11-02-2011	INV	PARTSORDER	30I00079		-6,985.30		199980
37	11-02-2011	INV	PARTSORDER	30I00079		-6,985.30		199980
38	11-02-2011	INV	PARTSORDER	30I00015		-519.16		199981
39	11-02-2011	INV	PARTSORDER	30I00015		-519.16		199981
Sheet1

 

[JoeMo]

It's bedtime so I haven't time to check this. Try it on a COPY of your workbook.

Option Compare Text
Sub RemoveNonAlphaDups()
Dim rng As Range
Dim lRw As Long, delRws As Range
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
lRw = Range("H" & Rows.Count).End(xlUp).Row
Set rng = Range("H2:H" & lRw)
For i = rng.Rows.Count To 1 Step -1
    If Not (rng.Cells(i).Value Like "[A-Z]*") Then
        If WorksheetFunction.CountIf(rng, rng.Cells(i).Value) > 1 Then
            rng.Cells(i).EntireRow.Delete
        End If
    End If
Next i
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

 

[howard]

Hi JoeMo

Thanks for the help. The code works well, except that it also removes duplicates beginning with an Alpha Character for Eg F14890. All refrences begiining with an Alpha character must be left intact

It would be appreciated if you would amend your code to accomodate this

 

[JoeMo]

Hi JoeMo

Thanks for the help. The code works well, except that it also removes duplicates beginning with an Alpha Character for Eg F14890. All refrences begiining with an Alpha character must be left intact

It would be appreciated if you would amend your code to accomodate this

In my tests it does not remove ANY data that begin with an alpha so I'm suspecting that your data may have a space in front of the alpha. I've modified the code so it will remove leading and trailing spaces.

Sub RemoveNonAlphaDups()
Dim rng As Range
Dim lRw As Long, delRws As Range
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
lRw = Range("H" & Rows.Count).End(xlUp).Row
Set rng = Range("H2:H" & lRw)
For i = rng.Rows.Count To 1 Step -1
    If Not (Trim(rng.Cells(i)) Like "[A-Z]*") Then
        If WorksheetFunction.CountIf(rng, rng.Cells(i).Value) > 1 Then
            rng.Cells(i).EntireRow.Delete
        End If
    End If
Next i
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

 

[howard]

Hi JoeMo

Thanks for the help. It is working perfectly. I need one more amendment to your code. I import the data and for some unkown reason there is a ref 204281-/ as well as a refrence as a ref 204281/* which your code picks up as a duplicate and deletes the record 204281/*

Please amend your code according as the duplicate references must be an exact match, before one of the duplicates are deleted

Your assistance in this regard will be most appreciated

 

[JoeMo]

Hi JoeMo

Thanks for the help. It is working perfectly. I need one more amendment to your code. I import the data and for some unkown reason there is a ref 204281-/ as well as a refrence as a ref 204281/* which your code picks up as a duplicate and deletes the record 204281/*

Please amend your code according as the duplicate references must be an exact match, before one of the duplicates are deleted

Your assistance in this regard will be most appreciated

Howard,
I copied these two refs directly from your post and do not find that either is deleted from a test list containing both. The only help I can offer at this point is if you will PM me, I will send you an email address for you to send me a test workbook with those two data entries copied directly from your imported data. Again, I suspect there may be some hidden characters in the imported data that make those two entries appear to be identical to Excel even though, visually, they are not.