VBA coding help

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

Code:

---

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

---

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

Change the red to suit?

Code:

---

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

---

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

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. :(

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

Does this work?

Code:

---

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

---

Yes that did it! thanks!