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!