I'm looking to improve the runtime and efficiency of my VBA code that performs multiple Replace
operations on an Excel Spreadsheet. I started out with the following (please forgive me for this horrendous mess):
Note: Some values/symbols did not show up correctly in this first piece of code
(blank values displayed in 'What:=""' and the ">" and "<" symbols displayed as normal ">" and "<" symbols, which they are not)
Private Sub symbolCheck()
Range("A2").Select
'Selects only to the end of all the data in the file to reduce processing time
Range(Selection, Selection.SpecialCells(xlLastCell)).Select
'Proceed with removing invalid symbols
'Apostrophe/Closing Single Quote
Selection.Replace What:="", Replacement:="'", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Apostrophe
Selection.Replace What:="`", Replacement:="'", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Opening Single Quote
Selection.Replace What:="", Replacement:="'", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Double Open Quotes
Selection.Replace What:="", Replacement:="""", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Double Closing Quotes
Selection.Replace What:="", Replacement:="""", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Dash
Selection.Replace What:="", Replacement:="-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Registered Trademark (R)
Selection.Replace What:="®", Replacement:="(R)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Trademark (TM)
Selection.Replace What:="", Replacement:="(TM)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Degree Symbol
Selection.Replace What:="°", Replacement:=" degrees", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Multiplication/x Symbol
Selection.Replace What:="×", Replacement:="x", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Upside-Down Question Mark Symbol
Selection.Replace What:="¿", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Solid Bullet Symbol
Selection.Replace What:="", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Triple Dots Symbol
Selection.Replace What:="", Replacement:="...", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Euro Symbol
Selection.Replace What:="", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Linebreak Symbol
Selection.Replace What:="|", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Less Than Symbol
Selection.Replace What:="<", Replacement:="<", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Greater Than Symbol
Selection.Replace What:=">", Replacement:=">", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Half Fraction
Selection.Replace What:="½", Replacement:=" 1/2", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Three Quarter Fraction
Selection.Replace What:="¾", Replacement:=" 3/4", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'One Quarter Fraction
Selection.Replace What:="¼", Replacement:=" 1/4", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
This code takes around 31.57 seconds to run on about 15000 row (~150 column) file.
After doing a decent amount of research and trial and error:
- I'm using the little tweaks (disabling various Excel activity) suggested here.
- I've adjusted/cleaned up my code according to the example given here, removing my extra
Replace
criteria that was not needed and using theWith
statement so I don't have to keep repetively referencing the range. However, I did not use the.SpecialCells(xlCellTypeConstants)
suggestion given in this example because my code actually ran much slower than when I useUsedRange
.
Leaving me with this updated version of my code:
Private Sub symbolCheck()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim r1 As Range
'Range("A2").Select
'Selects only to the end of all the data in the file to reduce processing time
'Set r1 = Range(Selection, Selection.SpecialCells(xlLastCell))
Set r1 = ActiveSheet.UsedRange
'Proceed with removing invalid symbols
With r1
'Apostrophe/Closing Single Quote
.Replace What:="’", Replacement:=Chr(39), LookAt:=xlPart
'Apostrophe
.Replace What:="`", Replacement:=Chr(39), LookAt:=xlPart
'Opening Single Quote
.Replace What:="‘", Replacement:=Chr(39), LookAt:=xlPart
'Double Open Quotes
.Replace What:="“", Replacement:="""", LookAt:=xlPart
'Double Closing Quotes
.Replace What:="”", Replacement:="""", LookAt:=xlPart
'Dash
.Replace What:="–", Replacement:="-", LookAt:=xlPart
'Registered Trademark (R)
.Replace What:="®", Replacement:="(R)", LookAt:=xlPart
'Trademark (TM)
.Replace What:="™", Replacement:="(TM)", LookAt:=xlPart
'Degree Symbol
.Replace What:="°", Replacement:=" degrees", LookAt:=xlPart
'Multiplication/x Symbol
.Replace What:="×", Replacement:="x", LookAt:=xlPart
'Upside-Down Question Mark Symbol
.Replace What:="¿", Replacement:="", LookAt:=xlPart
'Solid Bullet Symbol
.Replace What:="•", Replacement:="", LookAt:=xlPart
'Triple Dots Symbol
.Replace What:="…", Replacement:="...", LookAt:=xlPart
'Euro Symbol
.Replace What:="€", Replacement:="", LookAt:=xlPart
'Linebreak Symbol
.Replace What:="|", Replacement:=",", LookAt:=xlPart
'Less Than Symbol
.Replace What:="<", Replacement:="<", LookAt:=xlPart
'Greater Than Symbol
.Replace What:=">", Replacement:=">", LookAt:=xlPart
'Half Fraction
.Replace What:="½", Replacement:=" 1/2", LookAt:=xlPart
'Three Quarter Fraction
.Replace What:="¾", Replacement:=" 3/4", LookAt:=xlPart
'One Quarter Fraction
.Replace What:="¼", Replacement:=" 1/4", LookAt:=xlPart
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
After making those adjustments I'm still left around 26.5-27.8 seconds for the code to run on the same 15000 row (~150 column) file.
I've also come upon, but have not tried:
- I'm curious whether using a variation of Option 2 (using regEx) given here would help improve my time anymore.
- And I'm not sure whether going about this multiple find/replace action using arrays like here would be beneficial or help speed up the code anymore
Does anyone have any ideas or critique on how I can further increase the speed of this code?