vba to parse a large spreadsheet and only keep the most recent occurance column b

[john.tm]

i have some large reports that i get each day and have to sort into date time order and only keep the newest occurance based on column 2

at the moment i have a vba that converts the list to space delimetd columns, then selects all sorts into date time order, then deletes dupliactes as of column 2 keeping the most recent,

is there a more efficient way just to keep the most recent occurance and removing the rest

example file. so the 2nd row would be what i am left with

0 zztimrdevappg01 t bb zz 02/26/2014 19:04:30
3 zztimrdevappg01 t bbb bb 02/27/2014 02:04:31
8 zztimrdevappg01 hh bb zz 02/26/2014 19:04:32
0 zztimrdevappg01 hh bb bb 02/26/2014 19:04:34

many thanks

[tigeravatar]

So if that data is space delimited and the data starts in column A, the date would be in column F and the time would be in column G. Couldn't you just sort by column F and G descending, then delete all but the first row?

[john.tm]

Hi thanks for your reply
the file contains hundreds od different names in column 2 not just one like in the example

[tigeravatar]

Do you get the data in a text file? When the macro starts, should it ask you which text file to import the data from? If so, give this a try:

Sub tgr()
    
    Dim rngFirst As Range
    Dim rngLast As Range
    Dim rngDel As Range
    Dim oFSO As Object
    Dim arrData() As String
    Dim strFilePath As String
    
    strFilePath = Application.GetOpenFilename("Text Files, *.txt")
    If strFilePath = "False" Then Exit Sub  'Pressed cancel
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    arrData = Split(oFSO.OpenTextFile(strFilePath).ReadAll, vbCrLf)
    
    With Range("A1").Resize(UBound(arrData) - LBound(arrData) + 1)
        .Value = Application.Transpose(arrData)
        .TextToColumns .Cells, xlDelimited, xlTextQualifierDoubleQuote, True, Space:=True
        .CurrentRegion.Sort Intersect(.CurrentRegion, Columns("B")), xlAscending, _
                            Intersect(.CurrentRegion, Columns("F")), , xlDescending, _
                            Intersect(.CurrentRegion, Columns("G")), xlDescending
    End With
    
    Set rngFirst = Range("B1")
    Do
        Set rngLast = Columns.Find(rngFirst.Text, rngFirst, xlValues, xlWhole, , xlPrevious)
        If rngLast.Address <> rngFirst.Address Then
            Select Case (rngDel Is Nothing)
                Case True: Set rngDel = Range(rngFirst.Offset(1), rngLast)
                Case Else: Set rngDel = Union(rngDel, Range(rngFirst.Offset(1), rngLast))
            End Select
        End If
        Set rngFirst = rngLast.Offset(1)
        If IsEmpty(rngFirst) Then Exit Do
    Loop
    
    If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
    
End Sub

[john.tm]

hi
The data is imported from outlook, then converetd from text to columns, then sorted as you have done by column b then colulmn f and g.
i tried your code but unfortunately it froze up
regards john.tm

[tigeravatar]

I'd have to see a sample file. I can tell you that the code does work given the information I've been provided. It may just take awhile to run.