Shifting data down in a table with both forward and reverse loops - excel

Question

Please see an abstracted example in the image below
Warning! I'm very new to VBA and still learning, so there might be some obvious mistakes in my code.
I have a very large table of data containing several rows and columns. The objective is to loop through a column containing a bunch of IDs and detect duplicates in a specific segment of the string. As soon as there is a mismatch in this segment, the row and new value is stored before a reverse loop begins that shifts everything below down the last duplicate down by four spaces.
The result is three blank rows after all duplicates (see image).
There's a few conditions that I have to meet for this code to be compatible with the software that secures this sheet:
Inserting whole rows needs to be avoided, insert and shift down is okay
Avoiding select is ideal
No application enable/disable can be used
The fewer individual cell changes the better
The idea is to loop through each of the columns to shift all corresponding values in that row down once I have perfected the first column. It would be great to avoid having to do so if there's a way to shift the whole range down instead of individual cells.
The second, reverse loop seems to be the problem.
I've tried several ways of looping using integer loops, range for loops, do while, and do until.
Please let me know if you need clarification! Thank you so much for your help.
Sub shiftValues()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Tab1=Raw Data")
Dim lastRow As Variant
lastRow = ws1.Range("A" & ws1.Rows.count).End(xlUp).Row
Dim cell As Range
Dim rng As Range
Set rng = ws1.Range("A16:A" & lastRow)
Dim oldString As String
Dim newString As String
newString = "newString"
Dim oldRow As Integer
oldRow = 15 'Start of table
Dim beforeEqual() As String
beforeEqual = Split(ws1.Range("A15").Value, "=")
Dim tar As Long
For Each cell In rng
oldString = Right(beforeEqual(0), 2)
If cell.Value <> vbNullString And Len(cell.Value) > 6 Then
beforeEqual = Split(cell.Value, "=")
newString = Right(beforeEqual(0), 2)
If newString <> oldString And cell.Row > 15 Then
oldString = newString
oldRow = cell.Row
tar = lastRow
Do Until tar = oldRow
Range("A" & tar + 4).Value = Range("A" & tar).Value
Range("A" & tar).ClearContents
tar = tar - 1
Loop
End If
End If
Next cell
End Sub

Answer 1

This may do what you want:
j = 0
For i = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1
If Range("A" & i).Value <> Range("A" & i - 1).Value And Range("A" & i - 1).Value <> Range("A" & i - 2).Value Then
If j = 0 Then
j = i
Else
End If
Else
If j > 0 Then
Range("A" & i & ":A" & i + 2).Insert Shift:=xlDown
j = 0
End If
End If