2
\$\begingroup\$

I have a 13 MB file. When I run my macro it calculates the first rows in 3 different worksheets and then I use the AutoFill technique to next to 6000 rows and it takes too long time, something between 7-8 minutes.

Most of the formulas are simple and should not take to long time, in my opinion. Someone has solution to my problem? Maybe a way that the calculation itself will happen in the module and in the workbook we will see just the result, the values?

My code starts with a userform and then calls to a module, that takes most of the time that the macro runs. as I said each of the 3 sheets includes next to 6000 rows. I want that in the end in the worksheet I will see just the values.

Sub Formulas()

Call Columns

LR = VacationWS.Cells(Rows.Count, "A").End(xlUp).Row

With VacationWS
    'Column D
        MyCol = .Range("D2").Column
        ColumnSpace = MonthCol - MyCol
        .Range("D2").FormulaR1C1 = _
        "=SUMIFS(Visual!C[" & ColumnSpace & "],Visual!C[-3],VacationWS!RC[-3],Visual!C[5],Lists!R3C3,Visual!C[4],Lists!R2C5)"
    'Column E
        MyCol = .Range("E2").Column
        ColumnSpace = MonthBefore - MyCol
        .Range("E2").FormulaR1C1 = _
        "=SUMIFS(Visual!C[" & ColumnSpace & "],Visual!C[-4],VacationWS!RC[-4],Visual!C[4],Lists!R4C3,Visual!C[3],Lists!R5C5)"
    'Column F
        MyCol = .Range("F2").Column
        ColumnSpace = MonthCol - MyCol
        .Range("F2").FormulaR1C1 = _
        "=SUMIFS(Visual!C[" & ColumnSpace & "],Visual!C[-5],VacationWS!RC[-5],Visual!C[3],Lists!R2C3,Visual!C[2],Lists!R2C5)"
    'Column G
        .Range("G2").FormulaR1C1 = "=RC[-3]+RC[-2]-RC[-1]"
    'Column H
        MyCol = .Range("H2").Column
        ColumnSpace = MonthCol - MyCol
        .Range("H2").FormulaR1C1 = _
        "=SUMIFS(Visual!C[" & ColumnSpace & "],Visual!C[-7],VacationWS!RC[-7],Visual!C[1],Lists!R4C3,Visual!C,Lists!R5C5)"
    'Column I
        .Range("I2").FormulaR1C1 = "=RC[-1]-RC[-2]"

    'Delete unnecessary rows
    .Range("D2:I2").AutoFill Destination:=VacationWS.Range("D2:I" & LR), Type:=xlFillDefault
    .Range("A1:I1").AutoFilter
    .Range("$A$1:$I$" & LR).AutoFilter Field:=9, Criteria1:="0"
     On Error Resume Next
    .Range("A2:I" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .ShowAllData

End With


With IllnessWS
    'Column D
        MyCol = .Range("D2").Column
        ColumnSpace = MonthCol - MyCol
        .Range("D2").FormulaR1C1 = _
        "=SUMIFS(Visual!C[" & ColumnSpace & "],Visual!C[-3],IllnessWS!RC[-3],Visual!C[5],Lists!R3C3,Visual!C[4],Lists!R3C5)"
    'Column E
        MyCol = .Range("E2").Column
        ColumnSpace = MonthBefore - MyCol
        .Range("E2").FormulaR1C1 = _
        "=SUMIFS(Visual!C[" & ColumnSpace & "],Visual!C[-4],IllnessWS!RC[-4],Visual!C[4],Lists!R4C3,Visual!C[3],Lists!R6C5)"
    'Column F
        MyCol = .Range("F2").Column
        ColumnSpace = MonthCol - MyCol
        .Range("F2").FormulaR1C1 = _
        "=SUMIFS(Visual!C[" & ColumnSpace & "],Visual!C[-5],IllnessWS!RC[-5],Visual!C[3],Lists!R2C3,Visual!C[2],Lists!R3C5)"
    'Column G
        .Range("G2").FormulaR1C1 = "=RC[-3]+RC[-2]-RC[-1]"
    'Column H
        MyCol = .Range("H2").Column
        ColumnSpace = MonthCol - MyCol
        .Range("H2").FormulaR1C1 = _
        "=SUMIFS(Visual!C[" & ColumnSpace & "],Visual!C[-7],IllnessWS!RC[-7],Visual!C[1],Lists!R4C3,Visual!C,Lists!R6C5)"
    'Column I
        .Range("I2").FormulaR1C1 = "=RC[-1]-RC[-2]"

    'Delete unnecessary rows
    .Range("D2:I2").AutoFill Destination:=IllnessWS.Range("D2", "I" & LR), Type:=xlFillDefault
    .Range("A1:I1").AutoFilter
    .Range("$A$1:$I$" & LR).AutoFilter Field:=9, Criteria1:="0"
     On Error Resume Next
    .Range("A2:I" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .ShowAllData

    'Delete what is equal to 90 or more in column H
    .Range("$A$1:$I$" & LR).AutoFilter Field:=8, Criteria1:=">=90", Operator:=xlAnd
    .Range("A2:I" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .ShowAllData

End With


With HealingWS
    'Column D
        MyCol = .Range("D2").Column
        ColumnSpace = MonthCol - MyCol
        .Range("D2").FormulaR1C1 = _
        "=SUMIFS(Visual!C[" & ColumnSpace & "],Visual!C[-3],HealingWS!RC[-3],Visual!C[5],Lists!R3C3,Visual!C[4],Lists!R4C5)"
    'Column E
        MyCol = .Range("E2").Column
        ColumnSpace = MonthBefore - MyCol
        .Range("E2").FormulaR1C1 = _
        "=SUMIFS(Visual!C[" & ColumnSpace & "],Visual!C[-4],HealingWS!RC[-4],Visual!C[4],Lists!R4C3,Visual!C[3],Lists!R7C5)"
    'Column F
        .Range("F2").FormulaR1C1 = "=RC[-1]+RC[-2]"
    'Column G
        MyCol = .Range("G2").Column
        ColumnSpace = MonthCol - MyCol
        .Range("G2").FormulaR1C1 = _
        "=SUMIFS(Visual!C[" & ColumnSpace & "],Visual!C[-6],HealingWS!RC[-6],Visual!C[2],Lists!R4C3,Visual!C[1],Lists!R7C5)"
    'Column H
        .Range("H2").FormulaR1C1 = "=RC[-1]-RC[-2]"

    'Delete unnecessary rows
    .Range("D2:H2").AutoFill Destination:=HealingWS.Range("D2:H" & LR), Type:=xlFillDefault
    .Range("A1:H1").AutoFilter
    .Range("$A$1:$H$" & LR).AutoFilter Field:=8, Criteria1:="0"
     On Error Resume Next
    .Range("A2:H" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .ShowAllData

'Specific for June in HealingWS (Goes to Null)
    With Lists
        If MonthName = .Range("A7").Value Then
            HealingWS.Range("E2").Value = 0
            HealingWS.Range("E2").AutoFill Destination:=HealingWS.Range("E2:E" & LR), Type:=xlFillDefault
        End If
    End With
End With

'January formulas change
If MonthName = Lists.Range("A2").Value Then
    With VacationWS
        .Range("E2").FormulaR1C1 = _
        "=SUMIFS(December!C[7],December!C[-4],VacationWS!RC[-4],December!C[4],Lists!R4C3,December!C[3],Lists!R5C5)"
        .Range("E2").AutoFill Destination:=VacationWS.Range("E2:E" & LR), Type:=xlFillDefault
    End With

    With IllnessWS
        .Range("E2").FormulaR1C1 = _
        "=SUMIFS(December!C[7],December!C[-4],îçìä!RC[-4],December!C[4],Lists!R4C3,December!C[3],Lists!R6C5)"
        .Range("E2").AutoFill Destination:=IllnessWS.Range("E2:E" & LR), Type:=xlFillDefault
    End With

    With HealingWS
        .Range("E2").FormulaR1C1 = _
        "=SUMIFS(December!C[7],December!C[-4],HealingWS!RC[-4],December!C[4],Lists!R4C3,December!C[3],Lists!R7C5)"
        .Range("E2").AutoFill Destination:=HealingWS.Range("E2:E" & LR), Type:=xlFillDefault
    End With


End If

End Sub
Improve this question
\$\endgroup\$
4
  • 2
    \$\begingroup\$ As you've problem with the formula, not just with the code itself, it'd be beneficial to post sample data and formulas too. That would help us to understand your problem. \$\endgroup\$
    – Máté Juhász
    Nov 29, 2017 at 21:08
  • 5
    \$\begingroup\$ I don't see any code where you turn off the display of the data, that generally speeds things up. \$\endgroup\$
    – pacmaninbw
    Nov 30, 2017 at 16:48
  • 5
    \$\begingroup\$ Fully agree with @pacmaninbw here, that's usually the first thing to do when you run into performance problems with VBA in Excel. \$\endgroup\$
    – Mast ♦
    Nov 30, 2017 at 17:04
  • \$\begingroup\$ I have displays of screen updating, events and alerts in the start of the code that is not here \$\endgroup\$
    – Rafael Osipov
    Dec 3, 2017 at 8:06

1 Answer 1

Reset to default
1
\$\begingroup\$

When dealing with Formulas in Mass, do something with the Application.Calculation.

Sub Formulas()
    Dim lCalcMode As Long

    lCalcMode = Application.Calculation ' Store Current Calculation Mode
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual ' Change to manual Calculation

    Call Columns
    '... Your orginal Codes before End Sub ...

    Application.Calculation = lCalcMode ' Restore Calculation Mode
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

A calculation took place when related Ranges has changes if Calculation is Auto/SemiAuto. That should be the reason your code took so long to complete.

Improve this answer
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.