Public Sub produce_sum()
    Dim arrValues() As Variant
    Dim TotalRows As Long
    Dim i As Long
    Dim j As Long
    Dim Report As Worksheet 'Set up your new worksheet variable.
    Set Report = Excel.ActiveSheet 'Assign the active sheet to the variable.
    lRow = Range("D" & Rows.Count).End(xlUp).Row
    Set locations = Range("D2:D" & lRow)
    Range("G1").Value = "SUM"
    TotalRows = Rows(Rows.Count).End(xlUp).Row
    ReDim arrValues(1 To TotalRows)

    For i = 1 To TotalRows Step 3
        If locations(i).Value <> locations(i + 1).Value Or locations(i + 1).Value <> locations(i + 2).Value Or locations(i + 2).Value <> locations(i).Value Then
            locations(i).Interior.ColorIndex = 3
            locations(i + 1).Interior.ColorIndex = 3
            locations(i + 2).Interior.ColorIndex = 3
        End If
    Next

    For i = 2 To TotalRows
        arrValues(i) = Round(Cells(i, 3).Value, 3)
        Exit For
    Next

    j = 2
    For i = 2 To TotalRows - 1
        If i = j Or i = j + 3 Then
            ActiveSheet.Cells(i, 7).Value = Application.Sum(Range(Cells(i, 3), Cells(i + 2, 3)))
            j = i
        End If
    Next
End Sub