PDA

View Full Version : [SOLVED] VBA coding help



Teatimedgg1
09-16-2019, 07:25 PM
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
09-17-2019, 02:34 PM
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
09-18-2019, 05:12 PM
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
09-19-2019, 06:55 AM
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
09-19-2019, 02:57 PM
Perfect!! thank you all for your help! I wish it was that easy for me! lol :)

Teatimedgg1
09-20-2019, 08:01 AM
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
09-20-2019, 08:10 AM
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
09-20-2019, 08:30 AM
Yes that did it! thanks!