Filter Column by Value, if dups Aggregate Rows to 1 Rows

Adding the new columns at the end required that we initialize them in order to establish the array bounds - try this:

Sub SteinIII(): Dim P, Q, r As Long, s As Long, wa As Worksheet
Dim ID As String, n As Long, k As Long: s = 2
                Set wa = Sheets("Daily Input")
        If ActiveSheet.Name <> wa.Name Then Exit Sub
                    wa.AutoFilterMode = False
        wa.Cells(1, 35) = "Avg": wa.Cells(1, 36) = "Agg"
          wa.Columns("AI:AJ").NumberFormat = "0.00"
    P = wa.Cells(1, 2).CurrentRegion: wa.UsedRange.Offset(1).ClearContents
    Q = wa.Cells(1, 1).Resize(UBound(P, 1), UBound(P, 2))
        With CreateObject("Scripting.Dictionary")
            For r = 2 To UBound(P, 1): ID = P(r, 34): P(r, 36) = P(r, 11) * P(r, 8)
            If ID <> "" Then
        If .Exists(ID) Then
        k = .Item(ID): Q(k, 36) = Q(k, 36) + P(r, 36): Q(k, 11) = Q(k, 11) + P(r, 11)
        Else: .Item(ID) = s
        For n = 1 To UBound(P, 2): Q(s, n) = P(r, n): Next n: s = s + 1
        End If
        Else
        For n = 1 To UBound(P, 2): Q(s, n) = P(r, n): Next n: s = s + 1
        End If: Next r: k = s
        For r = 2 To s - 1: Q(r, 35) = Q(r, 36) / Q(r, 11): Next r
        wa.Cells(1, 1).Resize(UBound(Q, 1), UBound(Q, 2)) = Q
        End With
End Sub