Sub CenterAccts()
Dim ws As Worksheet, Sh As Worksheet
Dim C As Range, y As Long, z As Long
Dim Arr As Variant, Temp As Variant, yy As Long, zz As Long
Dim LR As Long, I As Long, p As Long, x As Integer, j As Integer
t = Timer
Application.ScreenUpdating = False
Set ws = Sheets("ayman")
Set Sh = Sheets("nour")
LR = ws.Range("B" & Rows.Count).End(xlUp).Row
Arr = ws.Range("A3:V" & LR)
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For I = 1 To UBound(Arr, 1)
x = WorksheetFunction.CountIfs(ws.Range("D3:D" & I + 2), Arr(I, 4), _
ws.Range("E3:E" & I + 2), Arr(I, 5))
If x = 1 Then
p = p + 1
For j = 1 To 2
Temp(p, j) = Arr(I, Choose(j, 4, 5))
Next
End If
Next
If p > 0 Then Sh.Range("C2").Resize(p, 4) = Temp
For Each C In Sh.Range("C2:C" & Sh.Range("C" & Rows.Count).End(xlUp).Row)
S = C.Offset(0, 1)
y = WorksheetFunction.SumIfs(ws.Range("K2:K" & LR), _
ws.Range("D2:D" & LR), C, ws.Range("E2:E" & LR), S)
yy = WorksheetFunction.SumIfs(ws.Range("U2:U" & LR), _
ws.Range("N2:N" & LR), C, ws.Range("O2:O" & LR), S)
z = WorksheetFunction.SumIfs(ws.Range("L2:L" & LR), _
ws.Range("D2:D" & LR), C, ws.Range("E2:E" & LR), S)
zz = WorksheetFunction.SumIfs(ws.Range("V2:V" & LR), _
ws.Range("N2:N" & LR), C, ws.Range("O2:O" & LR), S)
C.Offset(0, 2) = y + yy
C.Offset(0, 3) = z + zz
Next
Application.ScreenUpdating = True
MsgBox Round(Timer - t, 2)
End Sub