Macro to Find and Replace - Speed

[shades]

I had written a macro about two years ago that replaced longer company names with common abbreviations. I store it in Personal.xls, and it has been relatively fast (2-5 sec for most projects with < 2000 rows). However, I tried it on a file with 15,000 rows, and it choked Excel - i.e. it wouldn't run and had to be force quite (Excel XP on Windows 2000).

Here is a portion of the macro (I have about 40 companies that need to be abbreviated, names here have been simplified to protect the guilty ). I stepped through a couple of these lines to see what would happen, and each line took at least 1-2 min.

Sub ChgCompNames()

Application.ScreenUpdating = False
    Cells.Replace What:="Company AAAA", Replacement:="AAAA", LookAt:=xlPart, SearchOrder:=xlByRows
    Cells.Replace What:="Company BBBB", Replacement:="BBBB", LookAt:=xlPart, SearchOrder:=xlByRows
    Cells.Replace What:="Company CCCC", Replacement:="CCCC", LookAt:=xlPart, SearchOrder:=xlByRows
    Cells.Replace What:="Company DDDD", Replacement:="DDDD", LookAt:=xlPart, SearchOrder:=xlByRows
.
'etc. for all company names
.
.
Application.ScreenUpdating = True
End Sub

Is there a better way to go about the replacing? Or is there a way to make this more efficient? (I use this macro just about everyday, and this is the first time that I have run into such a problem.)

 

[Greg Truby]

Hiya Shades,

Ready for the playoffs ? Just a couple of thoughts you might try...

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> ChgCompNames()
    
    <SPAN style="color:#00007F">Dim</SPAN> calcOldMode <SPAN style="color:#00007F">As</SPAN> XlCalculation

    calcOldMode = Application.Calculation
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
    UsedRange.Replace What:="Company AAAA", Replacement:="AAAA", LookAt:=xlPart, SearchOrder:=xlByRows
<SPAN style="color:#007F00">'...</SPAN>
    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
    Application.Calculation = calcOldMode
    
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

</FONT>

Don't know if UsedRange.Replace is faster than Cells.Replace but you might test to see.

(Sorry about yer Vikings )

 

[shades]

So, it's now running well? [ I wouldn't think ~15k rows should kill XL, but maybe you had a bunch of other apps in background? ]

Yep, running like it should.

I though the same thing. Programs running: MS Outlook, MS Excel, MS Access (but wasn't doing anything, yet shut it down after first "choke"), and MS IE 5.5. I even turned off many of my add-ins just to see if that made a difference - no change.

The only thing that worked was to change to Automatic Calculation.

 

[shades]

Hiya Shades,

Ready for the playoffs ?

Well, two out of three - not bad. I was a Packers fan before Lombardi, before there was even a Vikings team.

And since I live within 3 miles of Arrowhead, well, go Chiefs (although I don't say that too loudly - I might jinx them, too!).

Thanks for the code. I will try that when I return to work on Monday.

Don't know if UsedRange.Replace is faster than Cells.Replace but you might test to see.

I will test this also. Thanks.

(Sorry about yer Vikings )

My brother still lives in MN. When I called him he didn't know; he left the TV with 2 minutes to go, and had to shovel some snow. As I told him: At least this saved the Vikings from embarrassing themselves in the playoffs!

 

[just_jon]

You 'n the 'Pack must go back a ways!

 

[shades]

And my back certainly agrees with that sentiment!

 

[parry]

The column can vary from spreadsheet to spreadsheet; within one spreadsheet it will always be the same column. Usuallythe company will be in one of these columns: A, B, C, or D (i.e. if in A, then it won't be in any other column).

There were no calculations of any kind in this specific spreasheet. The only way I found out that it was Manual Calculation was when I tried to determine how many characters in each company name, I used =LEN(B1) and filled down the column. Nothing happened. When I turned on Automatic Calculation, the formulas instantly changed. I then clicked my macro button - and within a minute all company names were changed (i.e. worked liked it normally did).

The more cells your looking at the slower it will be. If you have the name in only one column then thats all you should be looking at. As your column will vary the following code will ask you to select a column (just select the whole column) then only do a replace in that column. See if its quicker. You may be able to get it quicker again by using an array to store the company names but Im not sure that will make as big a difference as where you are looking at.

Sub ChgCompNames2()
Dim Rng As Range

Set Rng = Application.InputBox(prompt:="Select the column that contains the company name", _
Title:="Select Column", Type:=8)
If Rng Is Nothing Then Exit Sub

Application.ScreenUpdating = False
Rng.Replace What:="Company AAAA", Replacement:="AAAA", LookAt:=xlPart, SearchOrder:=xlByRows
Rng.Replace What:="Company BBBB", Replacement:="BBBB", LookAt:=xlPart, SearchOrder:=xlByRows
Rng.Replace What:="Company CCCC", Replacement:="CCCC", LookAt:=xlPart, SearchOrder:=xlByRows
Rng.Replace What:="Company DDDD", Replacement:="DDDD", LookAt:=xlPart, SearchOrder:=xlByRows

'etc. for all company names

Application.ScreenUpdating = True
End Sub

 

[parry]

Hi, heres an array version in case you wanted to try that. It will take some work on your part as you will have to put the company names your looking for into the LookArr variable and the replacement names (in the same order as the company names) into the ReplArr variable. Just put a comma after each and put quotes around the values.

Sub ChgCompNames3()
Dim Rng As Range, LookArr(), ReplArr(), a As Integer

Set Rng = Application.InputBox(prompt:="Select the column that contains the company name", _
Title:="Select Column", Type:=8)
If Rng Is Nothing Then Exit Sub

LookArr = Array("Company AAAA", "Company BBBB", "Company CCCC") 'put company names in here
ReplArr = Array("AAAA", "BBBB", "CCCC") 'put replacement names in here
Application.ScreenUpdating = False

For a = LBound(LookArr) To UBound(LookArr)
Rng.Replace What:=LookArr(a), Replacement:=ReplArr(a), LookAt:=xlPart, SearchOrder:=xlByRows
Next a

Application.ScreenUpdating = True
End Sub

 

[shades]

Thanks, Parry!

I'm no longer at work, so will have to wait until Monday. I had thought when the problem first cropped up this morning that another arrangement might make it easier and faster especially with selecting the column, because in a specific spreadsheet it would always be in the same column. This might very well do it.

Thank you. Thanks to everyone!!

Have a great New Year, and a safe one!!!

 

[Legacy 21301]

The more cells your looking at the slower it will be.

I think that it is most unlikely it will make any noticeable difference.

 

[parry]

The more cells your looking at the slower it will be.

I think that it is most unlikely it will make any noticeable difference.

You may be right but its worth a crack. I did a quick test in a range of 300,000 cells and there was only 1 second difference...

10X30000 = 4 secs (all 10 columns)
1X30000 = 3 secs (1 column)

But perhaps over 40 finds then it adds up, but shades may not be using that much data so it may not make much difference. No harm anyway.