Forum Discussion

waygar's avatar
waygar
Brass Contributor
Feb 15, 2023

Speeding Up VBA execution

Hi, The following code searches a large database for cells with a certain fill color and then removes the underlying conditional formatting. The runtime is quite slow. Can this code be made more eff...
Macros and VBA
HansVogelaar's avatar
HansVogelaar
MVP
Jul 25, 2023

waygar 

Hi Wayne, that depends on what the rest of the macro does.

 

If possible, the fastest way to do this would be to read the entire range into an array (that is just one instruction), manipulate that array, then writing the array back to the sheet (also one instruction).

Array manipulations are blindingly fast compared to cell manipulations.

waygar's avatar
waygar
Brass Contributor
Jul 25, 2023
Thanks Hans,
Firstly my testing using the code below does not seem to speed up the original code unless you have a better approach and secondly all the formatting associated with array processing is lost unfortunately so another technique rather than array processing would be necessary?
Your thought?
Cheers,
Wayne
Sub Switch()
Dim v3 As Variant
Dim NRows3 As Long
Dim I As Long
NRows3 = 25330
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Range("J6:J" & NRows3).Insert Shift:=xlToRight
Range("I6:I" & NRows3).Insert Shift:=xlToRight
v3 = Range("A7", "Q" & NRows3)

For I = 1 To NRows3 - 6
v3(I, 11) = v3(I, 6)
v3(I, 9) = v3(I, 5)
Next I

'Range("F6:F" & NRows3).Copy Destination:=wshCOMPL.Range("K6:K" & NRows3)
'Range("E6:E" & NRows3).Copy Destination:=wshCOMPL.Range("I6:I" & NRows3)

Range("F6:F" & NRows3).Delete
Range("E6:E" & NRows3).Delete
Range("A7", "Q" & NRows3) = v3
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Aug 22, 2023

    waygar 

    Please start a new discussion with that question. I cannot help you with it.

  • waygar's avatar
    waygar
    Brass Contributor
    Aug 22, 2023
    Hi Hans,
    Is there a way, using VBA, to change the permissions for defined users such as they can, edit or not, the Allow Edit Ranges set in a Protected Sheet using VBA and not just change the permissions manually each time eg when a user (with limited editing permission) is changed from being just a user to an administrator (with full editing permission)?
  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Jul 26, 2023

    waygar

    That is correct - keeping the formatting would slow down the code immensely.

    The choice is yours...

  • waygar's avatar
    waygar
    Brass Contributor
    Jul 26, 2023
    Works like a charm - I didnt use a tmp variable thinking the extra step would impose a delay.
    However usage of arrays does not keep the formatting , correct?
  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Jul 26, 2023

    waygar 

    Try this version:

    Sub Switch()
    Dim v As Variant
    Dim NRows3 As Long
    Dim I As Long
    Dim tmp1, tmp2, tmp4

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    NRows3 = 25330
    v = Range("E6:I" & NRows3).Value
    For I = 1 To UBound(v)
        tmp1 = v(I, 1)
        v(I, 1) = v(I, 3)
        v(I, 3) = tmp1
        tmp2 = v(I, 2)
        tmp4 = v(I, 4)
        v(I, 4) = v(I, 5)
        v(I, 2) = tmp4
        v(I, 5) = tmp2
    Next I
    Range("E6:I" & NRows3).Value = v

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

    Please test on a copy of the worksheet.

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Jul 26, 2023

    waygar 

    Yes, but that is a single number - the code applies to row 25330, not to any other rows.

    Or am I mistaken?

    Sorry, I didn't look closely enough.

    Stay tuned.

  • waygar's avatar
    waygar
    Brass Contributor
    Jul 26, 2023
    No to NRows3 rows which in the example is set to 25330
  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Jul 26, 2023

    waygar 

    So the code applies to a single row only? Is that correct?

  • waygar's avatar
    waygar
    Brass Contributor
    Jul 25, 2023
    A better and corrected version of the above is below and no faster"
    Sub Switch()
    Dim v5, v6, v9, v11 As Variant
    Dim NRows3 As Long
    Dim I As Long
    NRows3 = 25330
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Range("J6:J" & NRows3).Insert Shift:=xlToRight
    Range("I6:I" & NRows3).Insert Shift:=xlToRight

    v5 = Range("E6:E" & NRows3)
    v6 = Range("F6:F" & NRows3)
    v9 = Range("I6:I" & NRows3)
    v11 = Range("K6:K" & NRows3)

    v11 = v6
    v9 = v5

    Range("E6:E" & NRows3) = v5
    Range("F6:F" & NRows3) = v6
    Range("I6:I" & NRows3) = v9
    Range("K6:K" & NRows3) = v11

    'Range("F6:F" & NRows3).Copy Destination:=Range("K6:K" & NRows3)
    'Range("E6:E" & NRows3).Copy Destination:=Range("I6:I" & NRows3)

    Range("F6:F" & NRows3).Delete
    Range("E6:E" & NRows3).Delete

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    End Sub

Resources