1
\$\begingroup\$

I am wondering if there's any way to improve the performance of this simple "replace" / "autofill" loops that I created in excel?

Sub Macro1()



Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayStatusBar = False



For i = 1 To 50
Do


Sheets("Sheet1").Select



'Range("Q1:Q6").Value are random generated number using randbetween (=RANDBETWEEN(3,103))
'save the random created value to Range("U1:U6")
Sheet1.Range("U1:U6").Value = Sheet1.Range("Q1:Q6").Value




Range("AA1").Select




    'Column u1 to u6 are random values generated using =RANDBETWEEN(3,103).
'example of  Range("aa1") Pre-entered formula: =a5+b95+c48+d29+e62+f29
'replace the "a5" in range("aa1") with "a?", with the "?" being the random number in U1.
Selection.Replace What:="a" & Range("t1") & "+", Replacement:="a" & Range("u1") & "+", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False


    'replace the "B95" in range("aa1") with "a?", with the "?" being the random number in U2.
Selection.Replace What:="b" & Range("t2") & "+", Replacement:="b" & Range("u2") & "+", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False


    'replace the "C48" in range("aa1") with "a?", with the "?" being the random number in U3.
Selection.Replace What:="c" & Range("t3") & "+", Replacement:="c" & Range("u3") & "+", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False


    'replace the "D29" in range("aa1") with "a?", with the "?" being the random number in U4.
Selection.Replace What:="d" & Range("t4") & "+", Replacement:="d" & Range("u4") & "+", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False


    'replace the "E62" in range("aa1") with "a?", with the "?" being the random number in U5.

Selection.Replace What:="e" & Range("t5") & "+", Replacement:="e" & Range("u5") & "+", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    'replace the "F29" in range("aa1") with "a?", with the "?" being the random number in U6.
Selection.Replace What:="f" & Range("t6") & ",", Replacement:="f" & Range("u6") & ",", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False



'Autofill the modified formula in aa1 to aa1301.
Range("AA1").AutoFill Destination:=Range("AA1:AA1301")
'Manual re-calulate the autofills.
'Manual re-generate the random number

Calculate

    "Copy the number from U1:U6 (the =randbetween(3,103) to T1:T6 to save the random generated number.
'    
Sheet1.Range("T1:T6").Value = Sheet1.Range("U1:U6").Value



                         Loop Until Range("ac3") = 1 And Range("h8") >= 8 And Range("o3") = 0 And Range("o4") <> 0




Next i


 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 Application.EnableEvents = True
 Application.DisplayStatusBar = True



Beep

End Sub

Any better way to speed up the "replace" and the "autofill" or the whole macro even? It's pretty simple, just now fast enough!

Thanks

\$\endgroup\$
3
  • \$\begingroup\$ There are virtually no indentations in your code. Could you fix this please? It's hard to read. \$\endgroup\$
    – t3chb0t
    Nov 17, 2017 at 10:40
  • \$\begingroup\$ @t3chb0t not everyone knows how to indent their code, this isn't the first unindented piece of code to be posted on this site, all language tags combined. Probably not the last either ;-) \$\endgroup\$ Nov 17, 2017 at 14:48
  • \$\begingroup\$ FWIW, I would warmly recommend you take a look at rubberduckvba.com, especially the "indentation" page. Also feel free to try the add-in (it's an OSS project I manage & work on, along with many VBA reviewers on this site), its code inspections will help you learn better VBA faster, and certainly spare you from asking a number of Stack Overflow questions =) \$\endgroup\$ Nov 17, 2017 at 15:17

2 Answers 2

4
\$\begingroup\$

Just indenting the code and removing the excessive whitespace you have yields something significantly more readable (after also fixing the compile-error with the non-comment after Calculate):

Sub Macro1()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayStatusBar = False

    For i = 1 To 50
        Do
            Sheets("Sheet1").Select

            'Range("Q1:Q6").Value are random generated number using randbetween (=RANDBETWEEN(3,103))
            'save the random created value to Range("U1:U6")
            Sheet1.Range("U1:U6").Value = Sheet1.Range("Q1:Q6").Value

            Range("AA1").Select

            'Column u1 to u6 are random values generated using =RANDBETWEEN(3,103).
            'example of  Range("aa1") Pre-entered formula: =a5+b95+c48+d29+e62+f29
            'replace the "a5" in range("aa1") with "a?", with the "?" being the random number in U1.
            Selection.Replace What:="a" & Range("t1") & "+", Replacement:="a" & Range("u1") & "+", LookAt:=xlPart, _
                              SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                              ReplaceFormat:=False

            'replace the "B95" in range("aa1") with "a?", with the "?" being the random number in U2.
            Selection.Replace What:="b" & Range("t2") & "+", Replacement:="b" & Range("u2") & "+", LookAt:=xlPart, _
                              SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                              ReplaceFormat:=False

            'replace the "C48" in range("aa1") with "a?", with the "?" being the random number in U3.
            Selection.Replace What:="c" & Range("t3") & "+", Replacement:="c" & Range("u3") & "+", LookAt:=xlPart, _
                              SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                              ReplaceFormat:=False

            'replace the "D29" in range("aa1") with "a?", with the "?" being the random number in U4.
            Selection.Replace What:="d" & Range("t4") & "+", Replacement:="d" & Range("u4") & "+", LookAt:=xlPart, _
                              SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                              ReplaceFormat:=False

            'replace the "E62" in range("aa1") with "a?", with the "?" being the random number in U5.
            Selection.Replace What:="e" & Range("t5") & "+", Replacement:="e" & Range("u5") & "+", LookAt:=xlPart, _
                              SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                              ReplaceFormat:=False

            'replace the "F29" in range("aa1") with "a?", with the "?" being the random number in U6.
            Selection.Replace What:="f" & Range("t6") & ",", Replacement:="f" & Range("u6") & ",", LookAt:=xlPart, _
                              SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                              ReplaceFormat:=False

            'Autofill the modified formula in aa1 to aa1301.
            Range("AA1").AutoFill Destination:=Range("AA1:AA1301")
            'Manual re-calulate the autofills.
            'Manual re-generate the random number

            Calculate

            'Copy the number from U1:U6 (the =randbetween(3,103) to T1:T6 to save the random generated number.
            Sheet1.Range("T1:T6").Value = Sheet1.Range("U1:U6").Value

        Loop Until Range("ac3") = 1 And Range("h8") >= 8 And Range("o3") = 0 And Range("o4") <> 0
    Next i

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayStatusBar = True

    Beep
End Sub

Let's start with this.

The next step is breaking this into more manageable chunks:

Private Sub EnablePerformanceOptimizations()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayStatusBar = False
End Sub

Putting this together with the other block at the end of your current Macro1 we get:

Private Sub PerformanceOptimizations(ByVal enable As Boolean)
    Application.Calculation = IIf(enable, xlCalculationManual, xlCalculationAutomatic)
    Application.ScreenUpdating = Not enable
    Application.EnableEvents = Not enable
    Application.DisplayStatusBar = Not enable
End Sub

Now that this is finished we can "reimagine" Macro1 as the following

Public Sub Macro1()
    PerformanceOptimizations(True)

    GenerateAndCopyRandomNumbers()

    PerformanceOptimizations(False)
End Sub

Suddenly we can see "exactly" what Macro1 does. It does performance optimizations before generating random numbers and then disables the optimizations again.

The next step is to optimize that number generation.

The code you posted here does never use the loop variable of the For Next loop. We can just completely drop that loop, which already should reduce the runtime to \$\frac{1}{50}\$ of the current runtime...

The next step is optimizing these Replace calls.

The first step towards that would usually be to get rid of Selection because that's slow. I'll ignore that for now and just reformat the code (again) just to see what's actually going on:

Private Sub GenerateAndSaveRandomNumbers()
    Do
        Sheets("Sheet1").Select

        'Range("Q1:Q6").Value are random generated number using randbetween (=RANDBETWEEN(3,103))
        'save the random created value to Range("U1:U6")
        Sheet1.Range("U1:U6").Value = Sheet1.Range("Q1:Q6").Value

        Range("AA1").Select

        'Column u1 to u6 are random values generated using =RANDBETWEEN(3,103).
        'example of  Range("aa1") Pre-entered formula: =a5+b95+c48+d29+e62+f29
        'replace the "a5" in range("aa1") with "a?", with the "?" being the random number in U1.
        Selection.Replace What:="a" & Range("t1") & "+", _
                          Replacement:="a" & Range("u1") & "+", LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, _
                          SearchFormat:=False, ReplaceFormat:=False

        'replace the "B95" in range("aa1") with "a?", with the "?" being the random number in U2.
        Selection.Replace What:="b" & Range("t2") & "+", _
                          Replacement:="b" & Range("u2") & "+", LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, _
                          SearchFormat:=False, ReplaceFormat:=False

        'replace the "C48" in range("aa1") with "a?", with the "?" being the random number in U3.
        Selection.Replace What:="c" & Range("t3") & "+", _
                          Replacement:="c" & Range("u3") & "+", LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, _
                          SearchFormat:=False, ReplaceFormat:=False

        'replace the "D29" in range("aa1") with "a?", with the "?" being the random number in U4.
        Selection.Replace What:="d" & Range("t4") & "+", _
                          Replacement:="d" & Range("u4") & "+", LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, _
                          SearchFormat:=False, ReplaceFormat:=False

        'replace the "E62" in range("aa1") with "a?", with the "?" being the random number in U5.
        Selection.Replace What:="e" & Range("t5") & "+", _
                          Replacement:="e" & Range("u5") & "+", LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, _ 
                          SearchFormat:=False, ReplaceFormat:=False

        'replace the "F29" in range("aa1") with "a?", with the "?" being the random number in U6.
        Selection.Replace What:="f" & Range("t6") & ",", _
                          Replacement:="f" & Range("u6") & ",", LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, _
                          SearchFormat:=False, ReplaceFormat:=False

        'Autofill the modified formula in aa1 to aa1301.
        Range("AA1").AutoFill Destination:=Range("AA1:AA1301")
        'Manual re-calulate the autofills.
        'Manual re-generate the random number

        Calculate

        'Copy the number from U1:U6 (the =randbetween(3,103) to T1:T6 to save the random generated number.
        Sheet1.Range("T1:T6").Value = Sheet1.Range("U1:U6").Value

    Loop Until Range("ac3") = 1 And Range("h8") >= 8 And Range("o3") = 0 And Range("o4") <> 0
End Sub()

Now since Replace has quite a bunch of optional arguments, and you're overwriting most of them with defaults or unhelpful values, let's drop them:

  • MatchCase defaults to False
  • MatchByte isn't used in your code
  • SearchFormat would boil down to a Falsey if you didn't pass it
  • ReplaceFormat same considerations as for SearchFormat apply.

Interestingly we can even go so far as to abuse the fact that LookAt, SearchOrder and MatchCase (as well as MatchByte) are "saved" between invocations to collapse all this into the following replacement calls:

        'Column u1 to u6 are random values generated using =RANDBETWEEN(3,103).
        'example of  Range("aa1") Pre-entered formula: =a5+b95+c48+d29+e62+f29
        'replace the "a5" in range("aa1") with "a?", with the "?" being the random number in U1.
        Selection.Replace What:="a" & Range("t1") & "+", _
                          Replacement:="a" & Range("u1") & "+", LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False

        'replace the "B95" in range("aa1") with "a?", with the "?" being the random number in U2.
        Selection.Replace What:="b" & Range("t2") & "+", _
                          Replacement:="b" & Range("u2") & "+"

        'replace the "C48" in range("aa1") with "a?", with the "?" being the random number in U3.
        Selection.Replace What:="c" & Range("t3") & "+", _
                          Replacement:="c" & Range("u3") & "+"

        'replace the "D29" in range("aa1") with "a?", with the "?" being the random number in U4.
        Selection.Replace What:="d" & Range("t4") & "+", _
                          Replacement:="d" & Range("u4") & "+"

        'replace the "E62" in range("aa1") with "a?", with the "?" being the random number in U5.
        Selection.Replace What:="e" & Range("t5") & "+", _
                          Replacement:="e" & Range("u5") & "+"

        'replace the "F29" in range("aa1") with "a?", with the "?" being the random number in U6.
        Selection.Replace What:="f" & Range("t6") & ",", _
                          Replacement:="f" & Range("u6") & ","

Continued simplfications include not using Selection and using a With block:

With Sheet1.Range("AA1")
    .Replace What:="a" & Range("t1") & "+", _
             Replacement:="a" & Range("u1") & "+", LookAt:=xlPart, _
             SearchOrder:=xlByRows, MatchCase:=False
    'replace the "B95" in range("aa1") with "a?", with the "?" being the random number in U2.
    .Replace What:="b" & Range("t2") & "+", Replacement:="b" & Range("u2") & "+"

    'replace the "C48" in range("aa1") with "a?", with the "?" being the random number in U3.
    .Replace What:="c" & Range("t3") & "+", Replacement:="c" & Range("u3") & "+"

    'replace the "D29" in range("aa1") with "a?", with the "?" being the random number in U4.
    .Replace What:="d" & Range("t4") & "+", Replacement:="d" & Range("u4") & "+"

    'replace the "E62" in range("aa1") with "a?", with the "?" being the random number in U5.
    .Replace What:="e" & Range("t5") & "+", Replacement:="e" & Range("u5") & "+"

    'replace the "F29" in range("aa1") with "a?", with the "?" being the random number in U6.
    .Replace What:="f" & Range("t6") & ",", Replacement:="f" & Range("u6") & ","

This should give you another performance boost and will continue to work, even if the user changes the Selection during the execution of the macro.

\$\endgroup\$
1
  • 1
    \$\begingroup\$ I do hope somebody writes an answer regarding Qualification of references. This is necessary, but I didn't want to cram it into this already long answer... \$\endgroup\$
    – Vogel612
    Nov 17, 2017 at 15:05
1
\$\begingroup\$

AS @Vogel612 commented on, you should always fully-qualify your references. For more information watch: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset). You should always capitalize range addresses.

Try and write very simple concise and readable subroutines whenever possible. As a rule of thumb, if you have to scroll either vertically or horizontally consider refactoring.

When refactoring consider shortening long variable names. I appreciate the excessive code comments for the post,but in practice try to replacing excessive comments with better more descriptive variables names (avoid names like Macro1...lol). These two points are contradictory, just do whichever one makes the most sense at the time.

Ideally a subroutine will perform 1 or 2 simply tasks. While refactoring look repeat code and independant code blocks that can be outsourced to other subroutines and functions.

It's hard to say what can be done for improving the performance because you never really describe the dataset or what the other formulas, not included in MAcro1, are doing. Auto Filling is an unnecessary step. Simply apply the formula over the entire range.

The refactored code below may perform a slight bit faster. This probably isn't feasible but loading all the values into an array and performing the calculations on the array would greatly improve performance (100+ times faster).

Sub Evaluate_Sheet1()
    BoostSpeed True

    With ThisWorkbook.Sheets("Sheet1")
        For i = 1 To 50
            Do
                .Range("AA1:AA1301").Formula = getRandFormula
                Calculate
            Loop Until .Range("AC3") = 1 And .Range("H8") >= 8 And Range("O3") = 0 And .Range("O4") <> 0
        Next i
    End With

    BoostSpeed False
    Beep

End Sub

Function getRandFormula() As String
    Const lowerbound = 3, upperbound = 100
    With Application.WorksheetFunction
        getRandFormula = "=A" & .RandBetween(3, 103) & _
                         " + B" & .RandBetween(3, 103) & _
                         " + C" & .RandBetween(3, 103) & _
                         " + D" & .RandBetween(3, 103) & _
                         " + E" & .RandBetween(3, 103) & _
                         " + F" & .RandBetween(3, 103)
    End With

End Function

Sub BoostSpeed(TurnOn As Boolean)
    With Application
        .Calculation = IIf(TurnOn, xlCalculationAutomatic, xlCalculationManual)
        .ScreenUpdating = Not TurnOn
        .EnableEvents = Not TurnOn
        .DisplayStatusBar = Not TurnOn
    End With
End Sub
\$\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.