Forum Discussion
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...
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
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
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- 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,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.
- Hi Hans,
Do you lose cell formatting in this approach when moving data in and out of arrays?
