How to insert one row between non-duplicate row data and fill cell in inserted row

Question

I want to insert one row between non-duplicate row data and fill a cell with something from row above.

Table A --> Table B --> Table C

Answer 1

• By changing Range("E1") to Range("A1"), output table will overwrite the source table.

Option Explicit

Sub Demo()
    Dim i As Long, j As Long, k As Long
    Dim arrData, lastRow As Long
    Dim arrRes, RowCnt As Long, ColCnt As Long
    Dim rRow As Range, sRow As String, r, rCell as Range
    ' Load data
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    arrData = ActiveSheet.Range("A1:C" & lastRow).Value
    RowCnt = UBound(arrData)
    ColCnt = UBound(arrData, 2)
    ReDim arrRes(1 To RowCnt * 2, 1 To ColCnt)
    k = 1
    ' Loop through data
    For i = LBound(arrData) To RowCnt - 1
        For j = 1 To ColCnt
            arrRes(k, j) = arrData(i, j)
        Next j
        k = k + 1
        ' Add JOB row
        If Not arrData(i, ColCnt) = arrData(i + 1, ColCnt) Then
            arrRes(k, 1) = "JOB " & arrData(i, ColCnt)
            sRow = sRow & "," & k
            k = k + 1
        End If
    Next i
    ' Write data to sheet
    Set rCell = Range("E1")
    rCell.Resize(1, ColCnt).EntireColumn.Clear
    rCell.Resize(k - 1, ColCnt).Value = arrRes
    ' Apply color to JOB row
    For Each r In Split(Mid(sRow, 2), ",")
        If rRow Is Nothing Then
            Set rRow = rCell.Offset(r - 1).Resize(1, ColCnt)
        Else
            Set rRow = Application.Union(rRow, rCell.Offset(r - 1).Resize(1, ColCnt))
        End If
    Next
    If Not rRow Is Nothing Then
        rRow.Interior.Color = vbYellow
    End If
End Sub