I am trying the following code
Code: Select all
Sub Test()
Dim a, ws As Worksheet, sh As Worksheet, r As Range, txt As String, i As Long
Set ws = ThisWorkbook.Worksheets(1)
Set sh = ThisWorkbook.Worksheets(2)
sh.Range("A3:C" & Rows.Count).ClearContents
Set r = ws.Range("F2:M" & ws.Cells(Rows.Count, "F").End(xlUp).Row)
a = r.Value
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(a, 1)
If a(i, 8) = sh.Range("A1").Value Then
txt = Join(Array(a(i, 2), a(i, 3)), Chr(2))
If Not .Exists(txt) Then
.Item(txt) = .Count + 1
a(.Count, 1) = a(i, 2)
a(.Count, 2) = a(i, 3)
a(.Count, 3) = "=SUMIFS('" & ws.Name & "'!" & r.Columns(4).Address & ",'" & ws.Name & "'!" & r.Columns(1).Address & "," >= "&" & sh.Range("C1").Value & ",'" & ws.Name & "'!" & r.Columns(1).Address & "," <= " &" & sh.Range("D1").Value & ",'" & ws.Name & "'!" & r.Columns(2).Address & "," & a(.Count, 1) & ",'" & ws.Name & "'!" & r.Columns(3).Address & "," & a(.Count, 2) & ")"
End If
End If
Next i
i = .Count
End With
sh.Range("A3").Resize(i, 3).Formula = a
End Sub
What I am trying to fix is that part only
Code: Select all
a(.Count, 3) = "=SUMIFS('" & ws.Name & "'!" & r.Columns(4).Address & ",'" & ws.Name & "'!" & r.Columns(1).Address & "," >= "&" & sh.Range("C1").Value & ",'" & ws.Name & "'!" & r.Columns(1).Address & "," <= " &" & sh.Range("D1").Value & ",'" & ws.Name & "'!" & r.Columns(2).Address & "," & a(.Count, 1) & ",'" & ws.Name & "'!" & r.Columns(3).Address & "," & a(.Count, 2) & ")"