Looking for an alternative to obtain better performance from macro

J

jsantos77

New Member
Joined
Sep 18, 2008
Messages
20
Hi

I have a macro that replaces a few different words within a range of cells. It works fine but I was wondering if anyone would have a different approach to make it quicker?
This is the code i have currently:

Sub Sort1()
Application.ScreenUpdating = False
ActiveSheet.Unprotect
Dim myRange As Range
Set myRange = Range("E:CI")

With myRange
.Replace What:="Completed", Replacement:="pass", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="Available", Replacement:="x", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="Not Started", Replacement:="x", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="Refreshed", Replacement:="x", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="Started", Replacement:="x", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="Expired", Replacement:="x", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
Application.ScreenUpdating = True
End Sub

Any suggestions appreciated
Thanks
JSantos
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
Hello jsantos,

See if this helps:

VBA Code: 
Sub ReplaceVals()

'Change Sheet1 to sheet name or to ActiveSheet

    Dim i As Long, j As Long
    Dim ar As Variant: ar = Array("Available", "Not Started", "Refreshed", "Started", "Expired")
   
    For j = 3 To 90
          Sheet1.Columns(j).Replace What:="Completed", Replacement:="Pass", LookAt:=xlWhole
          For i = 0 To UBound(ar)
              Sheet1.Columns(j).Replace What:=ar(i), Replacement:="X"
          Next i
    Next j

End Sub


Cheerio,
vcoolio.
 
Upvote 0
The below uses Substitute which is case sensitive, so providing you can either
• rely on the case being consistently applied
• OR rely on the case being one of Proper case, Upper Case, Lower Case
The below is likely to be faster even though it is doing the replace 3 times to cater for the 3 case options.

Note: It also will only work without modification if your data range does not contain any formulas because it will write the result back as values.

VBA Code: 
Sub ReplaceText()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect
    Dim myRange As Range
    Dim myArr As Variant
    Dim lastRow As Long, i As Long
    Dim TxtToReplaceArr As Variant
    Dim oldTxt As String, newTxt As String
    
    Set myRange = Range("E:CI")
    lastRow = myRange.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set myRange = myRange.Resize(lastRow)
    myArr = myRange.Value
    
    ' Format:   OriginalText~ReplacementText
    ' Original entered as Proper case (1st letter capitalised)
    TxtToReplaceArr = Split("Completed~pass," & _
                            "Available~x," & _
                            "Not Started~x" & _
                            "Refreshed~x," & _
                            "Started~x," & _
                            "Expired~x", _
                            ",")
                            
    For i = 0 To UBound(TxtToReplaceArr)
        oldTxt = Split(TxtToReplaceArr(i), "~")(0)
        newTxt = Split(TxtToReplaceArr(i), "~")(1)
        
        ' Original Proper case
        myArr = Application.Substitute(myArr, oldTxt, newTxt)
        ' Upper case
        myArr = Application.Substitute(myArr, UCase(oldTxt), newTxt)
        ' Lower Case
        myArr = Application.Substitute(myArr, LCase(oldTxt), newTxt)
        
    Next i
    
    myRange.Value = myArr

End Sub
 
Upvote 0
Alex Blakenburg said:
The below uses Substitute which is case sensitive, so providing you can either
• rely on the case being consistently applied
• OR rely on the case being one of Proper case, Upper Case, Lower Case
The below is likely to be faster even though it is doing the replace 3 times to cater for the 3 case options.

Note: It also will only work without modification if your data range does not contain any formulas because it will write the result back as values.

VBA Code: 
Sub ReplaceText()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect
    Dim myRange As Range
    Dim myArr As Variant
    Dim lastRow As Long, i As Long
    Dim TxtToReplaceArr As Variant
    Dim oldTxt As String, newTxt As String
   
    Set myRange = Range("E:CI")
    lastRow = myRange.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set myRange = myRange.Resize(lastRow)
    myArr = myRange.Value
   
    ' Format:   OriginalText~ReplacementText
    ' Original entered as Proper case (1st letter capitalised)
    TxtToReplaceArr = Split("Completed~pass," & _
                            "Available~x," & _
                            "Not Started~x" & _
                            "Refreshed~x," & _
                            "Started~x," & _
                            "Expired~x", _
                            ",")
                           
    For i = 0 To UBound(TxtToReplaceArr)
        oldTxt = Split(TxtToReplaceArr(i), "~")(0)
        newTxt = Split(TxtToReplaceArr(i), "~")(1)
       
        ' Original Proper case
        myArr = Application.Substitute(myArr, oldTxt, newTxt)
        ' Upper case
        myArr = Application.Substitute(myArr, UCase(oldTxt), newTxt)
        ' Lower Case
        myArr = Application.Substitute(myArr, LCase(oldTxt), newTxt)
       
    Next i
   
    myRange.Value = myArr

End Sub
Click to expand...
FYI There is a ',' missing in this line :

"Not Started~x" & _

It should be :

"Not Started~x," & _

It all works fine for me.
 
Upvote 1
Solution
vcoolio said:
Hello jsantos,

See if this helps:

VBA Code: 
Sub ReplaceVals()

'Change Sheet1 to sheet name or to ActiveSheet

    Dim i As Long, j As Long
    Dim ar As Variant: ar = Array("Available", "Not Started", "Refreshed", "Started", "Expired")
  
    For j = 3 To 90
          Sheet1.Columns(j).Replace What:="Completed", Replacement:="Pass", LookAt:=xlWhole
          For i = 0 To UBound(ar)
              Sheet1.Columns(j).Replace What:=ar(i), Replacement:="X"
          Next i
    Next j

End Sub


Cheerio,
vcoolio.
Click to expand...
Thanks for taking the time to look at my query and sharing your approach. Unfortunately it takes longer to run than the previous code.
 
Upvote 0
Alex Blakenburg said:
The below uses Substitute which is case sensitive, so providing you can either
• rely on the case being consistently applied
• OR rely on the case being one of Proper case, Upper Case, Lower Case
The below is likely to be faster even though it is doing the replace 3 times to cater for the 3 case options.

Note: It also will only work without modification if your data range does not contain any formulas because it will write the result back as values.

VBA Code: 
Sub ReplaceText()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect
    Dim myRange As Range
    Dim myArr As Variant
    Dim lastRow As Long, i As Long
    Dim TxtToReplaceArr As Variant
    Dim oldTxt As String, newTxt As String
   
    Set myRange = Range("E:CI")
    lastRow = myRange.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set myRange = myRange.Resize(lastRow)
    myArr = myRange.Value
   
    ' Format:   OriginalText~ReplacementText
    ' Original entered as Proper case (1st letter capitalised)
    TxtToReplaceArr = Split("Completed~pass," & _
                            "Available~x," & _
                            "Not Started~x" & _
                            "Refreshed~x," & _
                            "Started~x," & _
                            "Expired~x", _
                            ",")
                           
    For i = 0 To UBound(TxtToReplaceArr)
        oldTxt = Split(TxtToReplaceArr(i), "~")(0)
        newTxt = Split(TxtToReplaceArr(i), "~")(1)
       
        ' Original Proper case
        myArr = Application.Substitute(myArr, oldTxt, newTxt)
        ' Upper case
        myArr = Application.Substitute(myArr, UCase(oldTxt), newTxt)
        ' Lower Case
        myArr = Application.Substitute(myArr, LCase(oldTxt), newTxt)
       
    Next i
   
    myRange.Value = myArr

End Sub
Click to expand...
Thanks Alex, With the small change highlighted by Herakles it worked a treat. I just need to work out why a INDEX & MATCH nested formula doesn't pick up the values from the table anymore.
Appreciate you taking the time to look at my code and proving your solution, it reduced the time to probably less than a quarter it was taken.
Thank you
 
Upvote 0
You're welcome. Glad we could help.
Thanks for giving is us an idea of what the performance improvement was.
 
Upvote 0
Hello jsantos,

I've only just received notification of your reply and I'm surprised that you found the code to take just as long as your previous code.
A short time ago, I went to the trouble of creating a test file based on what I believe it could look like from your first code. The code in post #2 took only 0.753 seconds to execute on 8000 rows of data on my machine. Mind you, I did get the columns wrong in post #2. This line:

For j = 3 To 90
should be
For j = 5 To 87

The only other thing that I could think of that may slow it down would be that your data set has many formulae calculating results for you. So. if you're interested, following is the code once again allowing for the turning off and turning on of any calculations by any formulae while the code executes. The column indexes have been corrected as well.

VBA Code: 
Sub ReplaceVals()

'Change Sheet1 to sheet name or to ActiveSheet

    Dim i As Long, j As Long
    Dim ar As Variant: ar = Array("Available", "Not Started", "Refreshed", "Started", "Expired")
  
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
  
    For j = 5 To 87
          Sheet1.Columns(j).Replace What:="Completed", Replacement:="Pass", LookAt:=xlWhole
          For i = 0 To UBound(ar)
              Sheet1.Columns(j).Replace What:=ar(i), Replacement:="X"
          Next i
    Next j
  
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
  
End Sub

Cheerio,
vcoolio.
 
Upvote 0
vcoolio said:
Hello jsantos,

I've only just received notification of your reply and I'm surprised that you found the code to take just as long as your previous code.
A short time ago, I went to the trouble of creating a test file based on what I believe it could look like from your first code. The code in post #2 took only 0.753 seconds to execute on 8000 rows of data on my machine. Mind you, I did get the columns wrong in post #2. This line:

For j = 3 To 90
should be
For j = 5 To 87

The only other thing that I could think of that may slow it down would be that your data set has many formulae calculating results for you. So. if you're interested, following is the code once again allowing for the turning off and turning on of any calculations by any formulae while the code executes. The column indexes have been corrected as well.

VBA Code: 
Sub ReplaceVals()

'Change Sheet1 to sheet name or to ActiveSheet

    Dim i As Long, j As Long
    Dim ar As Variant: ar = Array("Available", "Not Started", "Refreshed", "Started", "Expired")
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    For j = 5 To 87
          Sheet1.Columns(j).Replace What:="Completed", Replacement:="Pass", LookAt:=xlWhole
          For i = 0 To UBound(ar)
              Sheet1.Columns(j).Replace What:=ar(i), Replacement:="X"
          Next i
    Next j
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
End Sub

Cheerio,
vcoolio.
Click to expand...
Hi Vcoolio
Thanks for your time looking into it further, I found that by turning off calculation and screen updating it runs much faster. Not sure if the formulas I have on the workbook slow this process down as the majority are on other sheets and are just pulling information from the main sheet where this sorting takes place when I import the raw information. On the main sheet all i have are Sums, SumIfs and Ifs formulas and not a great deal.
Thanks once again for your time, much appreciated
Jsantos
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question
Clean Text - Remove Repeat Line Breaks
Replies
4
Views
259
lneidorf
L
M
  • Question
Saveas newwb, close new wb, delete old wb
Replies
8
Views
262
eiloken
E
M
  • Question
VBA changing values in multiple columns - where it should only be changing a single column
Replies
1
Views
57
Akuini
Akuini
R
  • Question
Replace links after moving worksheets from one workbook to another.
Replies
2
Views
181
RockandGrohl
R
R
  • Solved
Excel VBA error when attempting to replace text that has multiple lines a cell
2
Replies
11
Views
439
Revco
R

Forum statistics

Threads
1,216,045
Messages
6,128,477
Members
449,455
Latest member
jesski

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top