how to get the same result faster? please see VBA file.

[flora1]

please see file uploaded in OneDrive.


https://1drv.ms/x/s!AlfEVNV8SKm1dzv_eCrlCJVyLHc


currently, it takes more than 20 seconds to complete a simple calculation.


i am sure that there have to be a better and faster way to get the same result. but i wish i had that big brain like you experts.


any help is appreciated.

Sub Macro()


   Dim Main As Worksheet


    Set Main = Sheets("Main")
    Set ShD = Sheets("Data")


    intYearCol = Range("dataYear").Column
    intMonthCol = Range("dataMonth").Column
    intProductCol = Range("dataPRODUCT").Column
    intAmountCol = Range("dataAMOUNT").Column


    For Each cl In Range(Main.Range("B3"), Main.Range("K14"))
        mySum = 0
        Application.StatusBar = "Processing month " & Main.Cells(cl.Row, 1).Value & " for year " & Main.Cells(2, cl.Column).Value
        For Each c In Range(ShD.Range("a2"), ShD.Range("a" & Rows.Count).End(xlUp))


            If ShD.Cells(c.Row, intYearCol).Value = (Main.Cells(2, cl.Column).Value2 * 1) And ShD.Cells(c.Row, intMonthCol).Value = (Main.Range("A" & cl.Row).Value2 * 1) _
               And ShD.Cells(c.Row, intMonthCol).Value <> 111 And _
               ShD.Cells(c.Row, intProductCol).Value Like "[5-7]*" Then
                mySum = mySum + ShD.Cells(c.Row, intAmountCol).Value
            End If
        Next
        mySumReported = mySumReported + mySum - cl.Value
        If cl.Value = 0 And mySumReported <> 0 Then
            cl.Value = mySumReported
            mySumReported = 0
        End If
    Next


    Application.StatusBar = False


End Sub

also posted here

 

[AFPathfinder]

I'm guessing you have a lot of formulas in your workbook? Supposedly setting Application.Calculation = xlCalculationManual should stop the formulas from recomputing each time you make a change to the workbook, but I've never noticed a significant difference with my own VBA.

To get around the formula issue, I do one of two things: convert the formulas to text at the beginning, then revert back at the end or load all the new values to an array and update the range after the array has been filled.

 

[flora1]

I'm guessing you have a lot of formulas in your workbook? Supposedly setting Application.Calculation = xlCalculationManual should stop the formulas from recomputing each time you make a change to the workbook, but I've never noticed a significant difference with my own VBA.

To get around the formula issue, I do one of two things: convert the formulas to text at the beginning, then revert back at the end or load all the new values to an array and update the range after the array has been filled.

thanks. i got this resolved in another post referred.