Deleting almost duplicates?

Posted by Russell Sampson on October 06, 1999 6:08 PM

I am trying to have a macro compare cells for alpha text matches and if there is an alpha match delete the alpha match that has a numeric value on the end of the value. But I do not want to delete all the cells with a numeric value in them. Just the ones that have a duplicate alpha string. For expample:

jonesbo
jonesbo1
jonesbo4
smithto1
harriea

Using this data as sample I would only want the macro to remove jonesbo1 and jonesbo4 and leave the others untouched. How can this be done?

Posted by Ivan Moala on October 08, 1999 9:55 PM

Russell
I have assumed your Text-numerical data to be
in a single column ??
If so then the following macro will work.

Sub CompareTxtAlpha()

Dim IniTxt As String
Dim CmpTxt As String
Dim LenIniTxt As Integer
Dim MyRg As Range
Dim Cell2Comp
Dim x As Integer

'----------------------------------------
' Compares text in a column by
'1. Selecting the text column range
'2. Sorting in Ascending order
'3. Then Doing a partial text comparison
'----------------------------------------

'start of your Text data by column !
Range("A1").Select
Set MyRg = Range(ActiveCell, ActiveCell.End(xlDown))

MyRg.Select
Selection.Sort Key1:=MyRg, Order1:=xlAscending

For Each Cell2Comp In MyRg

Cell2Comp.Select
If Cell2Comp = "" Then GoTo NxtCell
IniTxt = Cell2Comp.Text 'Assign text to test
LenIniTxt = Len(IniTxt) 'get length so that
'we can compare ie. Text - any Numbers
For x = 1 To MyRg.Count - 1

CmpTxt = Cell2Comp.Offset(x, 0) 'Next String to compare against
'check for partial match
If IniTxt = Left(CmpTxt, LenIniTxt) Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Clear
Else
If x &LT; MyRg.Count Then
x = x + 1
End If
End If

Next x
NxtCell:
Next Cell2Comp
End Sub

regards

Ivan

Posted by Ivan Moala on October 08, 1999 10:02 PM

Russell,
Disregard the macro I posted, realised the criteria
I set up is not what you require !!
Sorry

Ivan

Posted by Ivan Moala on October 08, 1999 10:09 PM

Russell, had another look.
Small change gets it working.Sub CompareTxtAlpha()

Dim IniTxt As String
Dim CmpTxt As String
Dim TmpTxt
Dim LenIniTxt As Integer
Dim MyRg As Range
Dim Cell2Comp
Dim x As Integer

'start of your Text data by column !
Range("A1").Select
Set MyRg = Range(ActiveCell, ActiveCell.End(xlDown))

MyRg.Select
Selection.Sort Key1:=MyRg, Order1:=xlAscending

For Each Cell2Comp In MyRg

Cell2Comp.Select
If Cell2Comp = "" Then GoTo NxtCell
IniTxt = Cell2Comp.Text 'Assign text to test
LenIniTxt = Len(IniTxt) 'get length so that
'we can compare ie. Text - any Numbers
For x = 1 To MyRg.Count - 1

CmpTxt = Cell2Comp.Offset(x, 0) 'Next String to compare against
'check for partial match
If IniTxt = Left(CmpTxt, LenIniTxt) Then
If IniTxt = Cell2Comp.Text Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Clear
End If
Else
If x &LT; MyRg.Count Then
x = x + 1
End If
End If

Next x
NxtCell:
Next Cell2Comp
End Sub

Posted by Russell Sampson on October 11, 1999 4:50 PM

Thanks for your help worked like a charm!