Make code runs faster

Hello everyone
I have this code that works well but took a long time with large data

Sub Test()
    Dim LR As Long, LRData As Long
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    LR = Sheets("Balance").Cells(Rows.Count, "B").End(xlUp).Row
    LRData = Sheets("Data").Cells(Rows.Count, "B").End(xlUp).Row

    With Sheets("Balance")
        With .Range("E8:E" & LR)
            .Formula = "=SUMIFS(Data!R5C8:R" & LRData & "C8,Data!R5C1:R" & LRData & "C1,"">=""&Balance!R3C2,Data!R5C1:R" & LRData & "C1,""<=""&Balance!R4C2,Data!R5C2:R" & LRData & "C2,Balance!RC[-3])"
            .Value = .Value
        End With
        With .Range("F8:F" & LR)
            .Formula = "=SUMIFS(Data!R5C9:R" & LRData & "C9,Data!R5C1:R" & LRData & "C1,"">=""&Balance!R3C2,Data!R5C1:R" & LRData & "C1,""<=""&Balance!R4C2,Data!R5C2:R" & LRData & "C2,Balance!RC[-4])"
            .Value = .Value
        End With
    End With

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

Any ideas how to make it faster?

Try this...

Sub Test2()
    Dim Accts As Variant, Data As Variant, Results() As Double
    Dim d1 As Date, d2 As Date
    Dim i As Long, j As Long
    
    With Sheets("Data")
        Data = .Range("A5", .Range("A" & Rows.Count).End(xlUp)).Resize(, 9).Value
    End With
    
    With Sheets("Balance")
    
        Accts = .Range("B8", .Cells(Rows.Count, "B").End(xlUp)).Value
        ReDim Results(1 To UBound(Accts, 1), 1 To 2)
        d1 = .Range("B3").Value
        d2 = .Range("B4").Value
        
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
        
            For i = 1 To UBound(Accts, 1)
                .Item(Accts(i, 1)) = i
            Next i
            
            For i = 1 To UBound(Data, 1)
                If .Exists(Data(i, 2)) Then
                    If Data(i, 1) >= d1 And Data(i, 1) <= d2 Then
                        j = .Item(Data(i, 2))
                        If Data(i, 8) <> "" Then Results(j, 1) = Results(j, 1) + Data(i, 8)
                        If Data(i, 9) <> "" Then Results(j, 2) = Results(j, 2) + Data(i, 9)
                    End If
                End If
            Next i
            
        
        End With
        
        .Range("E8:F8").Resize(UBound(Results, 1)).Value = Results
        
    End With
    
End Sub

As a sidenote, is there a reason to do this in VBA in this specific way? I am no expert on pivot tables, but this type of problem (sum the values for several account numbers over a range of dates) seems like the perfect problem for a pivot table to solve. Pivot tables also tend to function very quickly.

Mr. AlphaFrog
That's exactly what I need .. It is very faster and the results are perfect
Thank you very much for this great help

MrShorty
I'm sorry I didn't notice your post.
In fact I am not good at using pivot tables or you may say I don't prefer it although it is very powerful
Thanks a lot for sharing