Perform Loop Based on Groupings of Rows - arrays

Question

this is my first time posting!
I have a data set similar to
Essentially there is data split into three columns (ID, Record, and Variable). For each "group" (based on the ID they share), I need to be able to reset the order of the records so that 4 and 5 come last in the "group." Then, the function would be able to go to the next one. Finally, I would expect a result like
A few key points:
I cannot use sorting/filtering because none of the IDs/Records/Variables in the true data set are in numeric order
Cannot split it out into different sheets/macros, because there are thousands of unique IDs.
Tried to work through this, but have some issues with my code doing nothing (below). Any ideas?
Sub GrpUpdate()
Dim f As Long
Dim i As Long
Dim last As Long
grpOne = "4"
grpTwo = "5"
i = 2
f = i
last = Range("A:A").Find(what:=Range("A" & f).Value, after:=Range("A" & f), searchdirection:=xlPrevious, LookIn:=xlValues).Row
For f = i To last
If f = last Then
i = last + 1
f = i
last = Range("A:A").Find(what:=Range("A" & f).Value, after:=Range("A" & f), searchdirection:=xlPrevious, LookIn:=xlValues).Row
ElseIf Not IsError(Application.Match(grpOne, "B" & f & ":" & "B" & last, 0)) And Not IsError(Application.Match(grpTwo, "B" & f & ":" & "B" & last, 0)) Then
Rows(Range("B" & f & ":" & "B" & last).Find(what:=grpOne, after:=Range("B" & f), searchdirection:=xlPrevious, LookIn:=xlValues).Row).Cut
Rows(last).Insert
Rows(Range("B" & f & ":" & "B" & last).Find(what:=grpTwo, after:=Range("B" & f), searchdirection:=xlPrevious, LookIn:=xlValues).Row).Cut
Rows(last).Insert
ElseIf Not IsError(Application.Match(grpOne, "B" & f & ":" & "B" & last, 0)) Then
Rows(Range("B" & f & ":" & "B" & last).Find(what:=grpOne, after:=Range("B" & f), searchdirection:=xlPrevious, LookIn:=xlValues).Row).Cut
Rows(last).Insert
ElseIf Not IsError(Application.Match(grpTwo, "B" & f & ":" & "B" & last, 0)) Then
Rows(Range("B" & f & ":" & "B" & last).Find(what:=grpTwo, after:=Range("B" & f), searchdirection:=xlPrevious, LookIn:=xlValues).Row).Cut
Rows(last).Insert
End If
Next f
End Sub

Answer 1

Try this out:
Sub GrpUpdate()
Dim f As Range, first As Long, last As Long
Dim ws As Worksheet, numRows As Long, addrGroups As String, arrLast, g
Set ws = ActiveSheet 'or whatever
first = 2 'start here
arrLast = Array("4", "5") 'items which (if present) should be last for each Id, in order
Do While Len(ws.Cells(first, "A").Value) > 0
With ws.Cells(first, "A") 'find the last value
last = ws.Range("A:A").Find(what:=.Value, after:=.Cells(1), _
searchdirection:=xlPrevious, lookat:=xlWhole).Row
End With
numRows = 1 + (last - first)
If numRows > 1 Then 'ignore single rows
'Using the range address because we're cutting rows which can be
' weird with Range references....
addrGroups = ws.Cells(first, "B").Resize(numRows).Address 'address for the "group" range
For Each g In arrLast 'loop items to be ordered last
Set f = ws.Range(addrGroups).Find(what:=g, lookat:=xlWhole)
If Not f Is Nothing Then
f.EntireRow.Cut 'move the found row to the end of the group
ws.Rows(last + 1).Insert
End If
Next g
End If '>1 row
first = last + 1 'next Id
Loop
End Sub