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

HansVogelaar

MVP

waygar

Is this better?

Sub Test()
    Dim RGBCode As Long
    Dim Cell As Range
    Dim Rng As Range
    Dim Adr As String
    Application.ScreenUpdating = False
    RGBCode = RGB(192, 0, 0)
    With Application.FindFormat
        .Clear
        .Interior.Color = RGBCode
    End With
    Set Cell = Range("D:D").Find(What:="", LookAt:=xlPart, SearchFormat:=True)
    If Not Cell Is Nothing Then
        Adr = Cell.Address
        Do
            If Rng Is Nothing Then
                Set Rng = Cell
            Else
                Set Rng = Union(Cell, Rng)
            End If
            Set Cell = Range("D:D").Find(What:="", After:=Cell, LookAt:=xlPart, SearchFormat:=True)
            If Cell Is Nothing Then Exit Do
        Loop Until Cell.Address = Adr
        Rng.FormatConditions.Delete
    End If
    Application.ScreenUpdating = True
End Sub

waygar

Brass Contributor

Mar 05, 2023

Thanks Hans,
The following section of code searches a sheet containing thousands of entries and places a "del" in the first column of a row satisfying certain conditions, marking that row for ultimately removing that row using say an autofilter deletion. The code is very slow when there are many rows of data. Is there a better more efficient means of implementing this sort of screening for eventual deletion?
Thank you.

Option Explicit
Sub Obsolete()
Dim l1Row As Long
Dim II As Long
Dim JJ As Long
Dim SBSO As String
SBSO = "SBS Online"

l1Row = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row

For II = 2 To l1Row
For JJ = 3 To l1Row
If Range("D" & II) = Range("D" & JJ) And Range("C" & II) = Range("C" & JJ) Then GoTo Label10
GoTo Label100
Label10:
If Range("E" & II) <> SBSO And Range("E" & JJ) <> SBSO Then GoTo Label200
If Range("E" & II) = SBSO And Range("F" & II) > Range("F" & JJ) Then Range("A" & II) = "del"
If Range("E" & JJ) = SBSO And Range("F" & JJ) > Range("F" & II) Then Range("A" & JJ) = "del"
GoTo Label200
Label100:
Next JJ
Label200:
Next II
End Sub

HansVogelaar

MVP

Mar 05, 2023

waygar

Try this. Please test it on a smaller subset first, to see if it works.

Sub Obsolete()
    Const SBSO = "SBS Online"
    Dim l1Row As Long
    Dim II As Long
    Dim JJ As Long
    Dim v As Variant

    Application.ScreenUpdating = False
    l1Row = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v = Range("A1:F" & l1Row).Value

    For II = 2 To l1Row - 1
        For JJ = II + 1 To l1Row
            If v(II, 4) = v(JJ, 4) And v(II, 3) = v(JJ, 3) Then
                If v(II, 5) <> SBSO And v(JJ, 5) <> SBSO Then Exit For
                If v(II, 5) = SBSO And v(II, 6) > v(JJ, 6) Then v(II, 1) = "del"
                If v(JJ, 5) = SBSO And v(JJ, 6) > v(II, 6) Then v(JJ, 1) = "del"
                Exit For
            End If
        Next JJ
    Next II

    Range("A1:F" & l1Row).Value = v
    Application.ScreenUpdating = True
End Sub

waygar
Brass Contributor
Mar 05, 2023
Thanks Hans,
That is unbelievable. A test data set took 80 seconds to complete with my code whereas your routine did it in less than a second.
Unbelievable.
Cheers,
- HansVogelaar
  MVP
  Mar 05, 2023
  waygar
  
  My version reads the data into an array, traverses the array and then writes the array back to the sheet in one go.
  
  Array manipulations are much faster than sheet manipulations.

Forum Discussion

Speeding Up VBA execution

Share

Resources