Optimize Slow VBA Code

[abc_abc_196]

Hi to every body
hope you all in great life
my question is
I have the below code and wonder if i can make it faster or replace it with another code faster than it
code is
Dim rng As Range, n As Range Set ws = Sheet3 [r1] = Now() Set rng = ws.Range("output") rng.ClearContents For Each n In rng n = Application.Evaluate("SUMPRODUCT((Dates>=" & ws.Cells(1, 4).Address & ")*(Dates<=" & ws.Cells(1, 5).Address & ")*(offices=" & ws.Cells(n.Row, 1).Address & ")*(asnaf = " & ws.Cells(1, n.Column).Address & ")*(totals))") Next [r2] = Now() MsgBox ("Done")
hope find help
thanks alot