Macro Help: Finding Letter/Number Combos

[jpedges38]

I have a set of data in column A as shown below:
<table border="0" cellpadding="0" cellspacing="0" width="169"><colgroup><col style="mso-width-source:userset;mso-width-alt:6180;width:127pt" width="169"> </colgroup><tbody><tr style="height:15.0pt" height="20"> <td style="height:15.0pt;width:127pt" height="20" width="169">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl64" style="height:15.0pt" height="20">3051CD2A02A1AH2B9E5L4</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl64" style="height:15.0pt" height="20">3051CD2A02A1AH2B9E5L4CN</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl64" style="height:15.0pt" height="20">3051CG4A02A1AH2B9E5</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl64" style="height:15.0pt" height="20">3051CG4A02A1AH2B9E5CN</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl64" style="height:15.0pt" height="20">3051CD3A03A1AH3B3M5E5T1</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl64" style="height:15.0pt" height="20">3051CD3A03A1AH3B3M5E5T1CN</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl64" style="height:15.0pt" height="20">3144PD1A1E1B4M5CN</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl64" style="height:15.0pt" height="20">3144PD1A1E1B4M5</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl64" style="height:15.0pt" height="20">3051CG5A02A1AH2E5M5CN</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl64" style="height:15.0pt" height="20">3051CG5A02A1AH2E5M5</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl64" style="height:15.0pt" height="20">3051CG5A02A1AH2E5M5CNQ4</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl64" style="height:15.0pt" height="20">3051CG5A02A1AH2E5M5Q4CN</td> </tr> </tbody></table>

Each pair listed above with a space in between is the same item, but they are showing up as different items in excel because of the order of the letters and numbers or because they are missing something.

Is their a way to make a formula that looks in each of the cells with the items and removes the "CN" from the item if there is a "CN" located anywhere in the item. Then it would check to see if items have the same letters and numbers, no matter what order they are in. Then it would add a "CN" to the combinations of letters and numbers that are the same and paste that result in column B.

So the last pair would go from
<table border="0" cellpadding="0" cellspacing="0" height="20" width="260"><tbody><tr height="20"><td class="xl64" style="height:15.0pt" height="20">3051CG5A02A1AH2E5M5CNQ4>3051CG5A02A1AH2E5M5Q4>3051CG5A02A1AH2E5M5Q4CN</td><td class="xl64" style="height:15.0pt" height="20">
</td></tr></tbody></table>
I do not even know where to start with this problem because they combinations of letters and numbers are many different lengths. Any help would be much appreciated.

Thanks,
J

 

[tlowry]

You should use the Replace function to Replace "CN" with "" before checking to see if the two are the same.

 

[JoeMo]

Assuming your data begins in A1 this should give you (in column B) the unique data items formed by removing "CN" from all items and then adding "CN" to the end of all duplicated items that result, then removing duplicates and sorting the list in ascending order.

Sub Reorder()
Dim lRw As Long, rng As Range, fRng As Range
Application.ScreenUpdating = False
lRw = Range("A" & Rows.Count).End(xlUp).Row
Set rng = Range("A1", "A" & lRw)
rng.Replace "CN", "", xlPart
For Each c In rng
    Set fRng = rng.Find(c.Value, after:=c, LookIn:=xlValues, lookat:=xlWhole)
    If Not fRng Is Nothing And fRng.Address <> c.Address Then
        c.Offset(0, 1).Value = c.Value & "CN"
        fRng.Offset(0, 1).Value = fRng.Value & "CN"
    End If
Next c
On Error Resume Next
Set fRng = rng.Offset(0, 1)
With fRng.SpecialCells(xlCellTypeBlanks)
    .Delete shift:=xlUp
End With
On Error GoTo 0
With fRng
    .Sort key1:=fRng.Cells(1, 1), order1:=xlAscending
    For I = fRng.Rows.Count To 2 Step -1
        If fRng.Cells(I, 1) = fRng.Cells(I - 1, 1) Then
            fRng.Rows(I).Delete shift:=xlUp
        End If
    Next I
End With
End Sub