Forum Discussion

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

waygar

Brass Contributor

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

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

HansVogelaar
MVP
Aug 22, 2023
waygar

Please start a new discussion with that question. I cannot help you with it.
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
MVP
Jul 26, 2023
waygar

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

The choice is yours...
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

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
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
Brass Contributor
Jul 26, 2023
No to NRows3 rows which in the example is set to 25330
HansVogelaar
MVP
Jul 26, 2023
waygar

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

Forum Discussion

Speeding Up VBA execution

Share

Resources