VBA coding help

[Teatimedgg1]

Hi Everyone,

I am looking to have some code take the data, sort by number and then by edit date. Step 2 would be to put a space when it sees a new number, Step 3 to take the highest time stamp and copy that row to another tab. End result would be all the highest time stamp on one tab. I have attached a sample file. thank you in advance for all your help! Also , Office 365

Tea

[Bob Phillips]

Public Sub Reorganise()
Dim lastrow As Long
Dim nextrow As Long
Dim targetrow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    With ActiveSheet
    
        .Range("A1:C1").Copy .Range("G1")
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A1:C1").Resize(lastrow).Sort Key1:=.Range("A1"), Order1:=xlAscending, _
                                             Key2:=.Range("C1"), Order2:=xlAscending, _
                                             Header:=xlYes
        nextrow = 2
        targetrow = 2
        For i = 3 To lastrow + 1
        
            If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then
            
                If .Cells(i, "C").Value > .Cells(targetrow, "C").Value Then
                
                    targetrow = i
                End If
            Else
            
                .Cells(targetrow, "A").Resize(, 3).Copy .Cells(nextrow, "G")
                nextrow = nextrow + 1
                targetrow = i
            End If
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub

[Teatimedgg1]

Works Great, Thank you! Just one modification. Can I have it copy to a new tab instead of in column G? Thanks for your help!
Tea

[paulked]

Change the red to suit?

Public Sub Reorganise()
Dim lastrow As Long
Dim nextrow As Long
Dim targetrow As Long
Dim i As Long


    Application.ScreenUpdating = False
    
    With ActiveSheet
    
        .Range("A1:C1").Copy Sheet2.Range("A1")
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A1:C1").Resize(lastrow).Sort Key1:=.Range("A1"), Order1:=xlAscending, _
                                             Key2:=.Range("C1"), Order2:=xlAscending, _
                                             Header:=xlYes
        nextrow = 2
        targetrow = 2
        For i = 3 To lastrow + 1
        
            If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then
            
                If .Cells(i, "C").Value > .Cells(targetrow, "C").Value Then
                
                    targetrow = i
                End If
            Else
            
                .Cells(targetrow, "A").Resize(, 3).Copy Sheet2.Cells(nextrow, "A")
                nextrow = nextrow + 1
                targetrow = i
            End If
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub

[Teatimedgg1]

Perfect!! thank you all for your help! I wish it was that easy for me! lol

[Teatimedgg1]

Well i thought that would work but it didnt copy over to sheet2. Any thoughts? I changed code to what you had listed in red.

[Bob Phillips]

The only way that could be so is if your sheet codename is not Sheet2.

Does this work?

Public Sub Reorganise()
Dim lastrow As Long
Dim nextrow As Long
Dim targetrow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    With ActiveSheet
    
        .Range("A1:C1").Copy Worksheets("Sheet2").Range("A1")
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A1:C1").Resize(lastrow).Sort Key1:=.Range("A1"), Order1:=xlAscending, _
                                             Key2:=.Range("C1"), Order2:=xlAscending, _
                                             Header:=xlYes
        nextrow = 2
        targetrow = 2
        For i = 3 To lastrow + 1
        
            If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then
            
                If .Cells(i, "C").Value > .Cells(targetrow, "C").Value Then
                
                    targetrow = i
                End If
            Else
            
                .Cells(targetrow, "A").Resize(, 3).Copy Worksheets("Sheet2").Cells(nextrow, "A")
                nextrow = nextrow + 1
                targetrow = i
            End If
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub

[Teatimedgg1]

Yes that did it! thanks!