VBA for Insert Rows based off Matching Values

Hi! I am attaching a file to help better explain -

I have a sheet that I am trying to figure out - After I run a quick macro to clean up the data, I am left with all of these values that I need to go thru and sum for a report

First, I need to insert cells based off 2 columns matching so I have an IF Statement ( I have this done on the sheet in col Q), the IF Statement produces the word "DELETE" when False which tells you when to insert a row below. If Col G2 matches Col G3 and if D2 matches D3 then keep going, if not then insert row below delete (since the code and desc are no longer the same). I will prob eventually try to convert that IF statment to insert via VBA

Next after rows are inserted, I need to sum all values from Col F but only for those that are within the groups based off the inserted rows (seen on Sheet2)

You will see on Sheet 1 how this looks "raw" and on Sheet 2 you will see how I inserted rows/summed

Any help would be greatly appreciated
EXample Book.xlsx

Hi! Sorry, could you provide a little detail and explanation to help me understand what is going on specificlly.

I see the match for Col D but also needs to match Col G

My apologies, my vba is a little weak.

With this macro you don't need the formulas in column Q or the data in column R.

Sub InsertRows()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, fRow As Long, lRow As Long
    v = Range("B2", Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
    For i = UBound(v) - 1 To LBound(v) Step -1
        If v(i, 1) <> v(i + 1, 1) Then
            Cells(i + 2, 1).EntireRow.Insert
        ElseIf v(i, 6) <> v(i + 1, 6) Then
            Cells(i + 2, 1).EntireRow.Insert
        End If
    Next i
    With Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
        For i = 1 To .Areas.Count
            fRow = .Areas(i).Cells(1).Row
            lRow = .Areas(i).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Range("F" & lRow + 1) = WorksheetFunction.Sum(Range("F" & fRow & ":F" & lRow))
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

Try:

Sub InsertRows()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, fRow As Long, lRow As Long
    v = Range("B2", Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
    For i = UBound(v) - 1 To LBound(v) Step -1
        If v(i, 1) <> v(i + 1, 1) Then
            Cells(i + 2, 1).EntireRow.Insert
        ElseIf v(i, 6) <> v(i + 1, 6) Then
            Cells(i + 2, 1).EntireRow.Insert
        End If
    Next i
    With Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
        For i = 1 To .Areas.Count
            fRow = .Areas(i).Cells(1).Row
            lRow = .Areas(i).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With Range("F" & lRow + 1)
                .Value = WorksheetFunction.Sum(Range("F" & fRow & ":F" & lRow))
                .Font.Bold = True
            End With
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

Try:

Sub InsertRows()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, fRow As Long, lRow As Long
    With ActiveSheet
        .Range("B1").CurrentRegion.AutoFilter 2, "YOGLP"
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .Range("B1").AutoFilter
    End With
    v = Range("B2", Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
    For i = UBound(v) - 1 To LBound(v) Step -1
        If v(i, 1) <> v(i + 1, 1) Then
            Cells(i + 2, 1).EntireRow.Insert
        ElseIf v(i, 6) <> v(i + 1, 6) Then
            Cells(i + 2, 1).EntireRow.Insert
        End If
    Next i
    With Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
        For i = 1 To .Areas.Count
            fRow = .Areas(i).Cells(1).Row
            lRow = .Areas(i).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With Range("F" & lRow + 1)
                .Formula = "=Sum(F" & fRow & ":F" & lRow & ")"
                .Font.Bold = True
            End With
        Next i
    End With
    Application.ScreenUpdating = True
End Sub