Delete Row but containing most recent data

[Crafty64]

Hi, I have a column of data and would like to remove duplicates and the enitre row. Duplicates would be where the first 16 characters are the same in the string and the most recent cell (which is what I want to keep) would have the highest number for the last character.So for example this is what I would like to do:

<TABLE style="WIDTH: 254pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=338 x:str><COLGROUP><COL style="WIDTH: 103pt; mso-width-source: userset; mso-width-alt: 5010" width=137><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 103pt; mso-width-source: userset; mso-width-alt: 5010" width=137><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 103pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" class=xl24 height=17 width=137 x:str="Before ">Before </TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64></TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 103pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" class=xl24 width=137>After</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" height=17>00000219279TRLO0-1</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8"></TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8">00000219279TRLO0-2</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" height=17>00000219279TRLO0-2</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8"></TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8">00000219280TRLO0-4</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" height=17>00000219280TRLO0-1</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8"></TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8"></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" height=17>00000219280TRLO0-2</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8"></TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8"></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" height=17>00000219280TRLO0-3</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8"></TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8"></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" height=17>00000219280TRLO0-4</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8"></TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8"></TD></TR></TBODY></TABLE>

Any suggestions would be most welcome! Would prefer a VBA solution if there is one...

Thanks

 

[venkat1926]

the data from A1 to B6 in sheet1
00000219279TRLO0-1
00000219279TRLO0-2
00000219280TRLO0-1
00000219280TRLO0-2
00000219280TRLO0-3
00000219280TRLO0-4

copy this data in sheet 1 to sheet 2 also to preserve original data(this is used in macro "undo")

try this macro "test" (the other macro undo is to undo the result of the macro) and see column F in sheet1

Sub test()
Application.DisplayAlerts = False
Dim r As Range, c As Range
Worksheets("sheet1").Activate
Range("A1:A7").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True

Range("A1").Sort key1:=Range("A1"), header:=xlNo
Range(Range("A1"), Range("A1").End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("A1").EntireRow.Insert
Range("A1") = "hdng1"
Range("B1") = "hdng2"
Range("A1").Subtotal GroupBy:=1, Function:=xlMax, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Set r = Range(Range("A1"), Cells(Rows.Count, "A").End(xlUp))
For Each c In r
If c.Font.Bold = True Then
Range(c, c.Offset(0, 1)).Copy
Cells(Rows.Count, "f").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
Next c
Range("A1").RemoveSubtotal
Set r = Range(Range("F2"), Range("F2").End(xlDown))
For Each c In r
c = Left(c, 16) & "-" & c.Offset(0, 1)
Next c
Range("G1").EntireColumn.Delete
Range("F1").EntireColumn.AutoFit
Range("A1:A7").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
Application.DisplayAlerts = True
End Sub

Sub undo()
Worksheets("sheet1").Activate
Cells.Clear
Worksheets("sheet2").Cells.Copy Range("A1")
End Sub

 

[Crafty64]

Thank you sir, works a treat!