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.)

 

[shades]

Update: I tried to add/omit various VBA References, and nothing happened. Then I tried changing/deleting all add-ins. Still nothing - the warning "File Not Found" still appeared.

Finally I went into the
C:\Documents and Settings\Microsoft\Application Data\Microsoft\Excel\XLStart

There were two extra files:

FE261100 (unidentified)
XLStart.xla

So, I moved both to another folder, and eventually in the Recycle Bin (didn't delete yet). Restarted Excel - no warning!! Eureka.

[Edit: I had to move XLStart.xla back into the folder]

So, that problem is solved.

Ponsy. I just got out of an extended meeting, so haven't had a chance to test your solution. But I will keep you informed.

 

[shades]

Shades,

Time for one more?

Oh, yes!

In the following procedure, you have a worksheet named “Setup” that contains your current company names in column A and the replacement names in column B. The data in columns A and B is named “MyRng”, a dynamic rangethat increases/decreases as you add/delete data.


Macro in a standard module:

Sub replaceNames()
Dim myReplace As Variant
Dim i As Integer

Application.ScreenUpdating = False

 With ThisWorkbook.Worksheets("Setup")
    myReplace = .Range("MyRng").Value
 End With

 For i = 1 To UBound(myReplace)
    If Not IsEmpty(myReplace(i, 1)) Then
      ActiveSheet.Cells.Replace What:=myReplace(i, 1), _
             Replacement:=myReplace(i, 2)
    End If
 Next i

Application.ScreenUpdating = True

End Sub

From an administration point of view, maintaining company names in a worksheet may be easier than hard-coding the names in a macro, particularly as you state that company names may be “one word, two words, or in a few cases five words” (hard-coding your 40 company names, and 40 replacement names, would drive me nuts).


See this line starting with:

ActiveSheet.Cells

The macro looks at the entire worksheet.

You may wish to restrict the macro to a specific column:

ActiveSheet.Range("A:A")

I will be interested to know how the macro performs against your data. Perhaps there is a trade-off between macro speed and maintaining the data.

Mike, I tried the first one, and I quit the process after 3+ minutes, no changes, etc. showed up, processor working at 100%.

However, when I restricted the change column to one as you suggested (Column A:A for this test), then the macro took 10+ sec (with 236 company names and 14786 rows of data). So very good showing. I'm keeping this one handy as well.

Thanks, Mike.

 

[shades]

Shades

Would be interested in how long the macro I posted takes (based on using VLOOKUP).

Thanks.

I tried yours, but it ended up changing only cell A1 on the target ("Sheet1") (i.e. replaced the header, but none of the company names). For the next few hours I won't be able to troubleshoot to find out why it did that. But I will keep at it and let you know.

 

[Legacy 21301]

I tried yours, but it ended up changing only cell A1 on the target ("Sheet1") (i.e. replaced the header, but none of the company names). For the next few hours I won't be able to troubleshoot to find out why it did that. But I will keep at it and let you know.

Sorry, I posted the wrong code. Should be :-

Sub replaceNames()
Dim rng As Range, lr#
Application.ScreenUpdating = False
With Sheets("Sheet1")
    .Columns(1).Insert
    Set rng = .Range(.[B1], .[B65536].End(xlUp)).Offset(0, -1)
    lr = Sheets("Sheet2").[A65536].End(xlUp).Row
    With rng
        .FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[1],Sheet2!R1C1:R" & lr & "C2,2,0)),RC[1],VLOOKUP(RC[1],Sheet2!R1C1:R" & lr & "C2,2,0))"
        .Value = .Value
    End With
    .Columns(2).Delete
End With
Application.ScreenUpdating = True
End Sub

 

[XL-Dennis]

shades,

Since it seems very popular to ask about each solutions performance I thought I might join the gang as well :wink:

Time to uncover the power of ADO & SQL on Your 'old & junky' computer and let the world know the time for it to be executed (especially when You made it to a 1 x column issue)

I hope You have access to ADO on Your machine and it is the last provided procedure You should aim on.

Take care buddy

Dennis

 

[Ekim]

Ponsy,

Tried your second code – worked perfectly (and appears to be very quick, although my test data was fairly small). However, if there are blank lines between company names (sheet 1), the macro returns a zero. This problem is solved if you change this line:

.FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[1],Sheet2!R1C1:R" & lr & "C2,2,0)),RC[1],VLOOKUP(RC[1],Sheet2!R1C1:R" & lr & "C2,2,0))"

to:

.FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[1],Sheet2!R1C1:R" & lr & "C2,2,0)),"""",VLOOKUP(RC[1],Sheet2!R1C1:R" & lr & "C2,2,0))"

Regards,

Mike

 

[shades]

Hi Tommy et al,

Anyway, here comes a better example :wink:

Option Explicit

Sub UpDate_Company_Names()
Dim wbTarget As Workbook, wbSource As Workbook
Dim wsTarget As Worksheet, wsSource As Worksheet
Dim rnSource As Range, rnTarget As Range, rnFind As Range
Dim vaSource As Variant, vaTarget As Variant
Dim i As Long

Dim cnt As ADODB.Connection
Dim stCon As String, stSQL As String, stFile As String

Set wbSource = ThisWorkbook
'The sheetname is here named "Company Names", which holds the names.
Set wsSource = wbSource.Worksheets("Company Names")

With wsSource
'Column A holds the values that will be replaced.
Set rnSource = .Range(.Range("A2"), .Range("A65536").End(xlUp))
'Column B holds the values that will replace the values.
Set rnTarget = .Range(.Range("B2"), .Range("B65536").End(xlUp))
End With

Set wbTarget = ActiveWorkbook
Set wsTarget = ActiveSheet

vaSource = rnSource.Value
vaTarget = rnTarget.Value

'Collect the path and name of the targetworkbook.
With wbTarget
stFile = .Path & "\" & .Name
End With

Application.ScreenUpdating = False

stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & stFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"

Set cnt = New ADODB.Connection
cnt.Open stCon

For i = LBound(vaSource) To UBound(vaSource)
'The expression assumes that there exist fieldnames
'and that one of them is named "Company" in the targetsheet "Name"

stSQL = "UPDATE [Name$] SET Company = '" & vaTarget(i, 1) & "'" _
& " WHERE Company = '" & vaSource(i, 1) & "';"

cnt.Execute stSQL, , adCmdText Or adExecuteNoRecords

stSQL = ""
Next i

Application.ScreenUpdating = True

'Cleaning up.
cnt.Close
Set cnt = Nothing

End Sub

Now I will take a closer look on Your latest solution

Kind regards,
Dennis

Okay, Dennis. You prodded me enough OUCH! Actually I may not have time to fully test this until next Monday-Tuesday. Anyway, before I begin to use this, I want to understand a little more. I know nothing about SQL. So my questions might simple-minded.

Is the connection to the database necessary in my case? Or is this "database" just my source file, in this case an Excel sheet? Here is the part that seems a little confusing. (I changed the Extended Properties to Excel 10.0 since I am using Excel 2002). Target sheet "Name"? Just to be sure, is "Company" the field name in the source, and "Name" the field name in the target?

Application.ScreenUpdating = False

stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & stFile & ";" & _
"Extended Properties=""Excel 10.0;HDR=Yes"";"

Set cnt = New ADODB.Connection
cnt.Open stCon

For i = LBound(vaSource) To UBound(vaSource)
'The expression assumes that there exist fieldnames
'and that one of them is named "Company" in the targetsheet "Name"

stSQL = "UPDATE [Name$] SET Company = '" & vaTarget(i, 1) & "'" _
& " WHERE Company = '" & vaSource(i, 1) & "';"

cnt.Execute stSQL, , adCmdText Or adExecuteNoRecords

As soon as I get my mind around this (as old as I am, it may take a decade or two), I want to use it. Thanks.

 

[XL-Dennis]

shades,

is this "database" just my source file

Per se we treat the XL-file as a database-file and therefore need to connect to the file that we want to evaluate.

"Extended Properties=""Excel 8.0;HDR=Yes"";"

1. You can´t change the Extended properties to 10.0. It must be 8.0 and have nothing to do which version of XL You're running.

2a wbTarget = the workbook that holds the worksheet in which the list of company names that will be checked against the list in wsSource. (It is always the active workbook.)
2b We assumes here that wbTarget has a worksheet named "Name".

3a We must insert columnnames (ie fieldnames) in the 1st row in the worksheet "Name" which are necessary to get it to work.
3b and the column that holds the company names to be evaluated must have the name "Company".

Option Explicit

Sub UpDate_Company_Names()
Dim wbTarget As Workbook, wbSource As Workbook
Dim wsSource As Worksheet
Dim rnSource As Range, rnTarget As Range, rnFind As Range
Dim vaSource As Variant, vaTarget As Variant
Dim i As Long, lnMode As Long
Dim cnt As ADODB.Connection
Dim stCon As String, stSQL As String, stFile As String

Set wbSource = ThisWorkbook
'The sheetname is here named "Company Names", which holds the names.
Set wsSource = wbSource.Worksheets("Company Names")

With wsSource
'Column A holds the values that will be replaced.
Set rnSource = .Range(.Range("A2"), .Range("A65536").End(xlUp))
'Column B holds the values that will replace the values in column A.
Set rnTarget = .Range(.Range("B2"), .Range("B65536").End(xlUp))
End With

'This is the workbook that holds the worksheet "Name" and should be open when
'this procedure is executed.
Set wbTarget = ActiveWorkbook

'Read the lists of names into one-dimensional arrays of the datatype variant.
vaSource = rnSource.Value
vaTarget = rnTarget.Value

'Collect the path and name of the targetworkbook.
stFile = wbTarget.FullName

'Pick up the setting for the present calculation mode.
lnMode = Application.Calculation

'Here we turn off some settings to speed things up.
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

'The extended property setting has nothing to do which version of XL
'You're running and here we create the connection-string which will be
'used when we open the connection, i e connect to the database-file.
stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & stFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"

'Instantiate the declared ADO-object which is the preferred method then
'compared with declaring the variable as New.
Set cnt = New ADODB.Connection
'Open the connection
cnt.Open stCon

'Loop through the array and create the SQL-statement for each item and then
'execute it and update in a chunck.
For i = LBound(vaSource) To UBound(vaSource)
'[Name$] = The name of the worksheet and the $ tells XL that the worksheet exist.
stSQL = "UPDATE [Name$] SET Company = '" & vaTarget(i, 1) & "'" _
& " WHERE Company = '" & vaSource(i, 1) & "';"

'Here we execute the SQL-expression.
cnt.Execute stSQL, , adCmdText Or adExecuteNoRecords
'Empty the SQL-string
stSQL = ""
Next i

'Turn on some settings
With Application
.ScreenUpdating = True
.Calculation = lnMode
End With

'Cleaning up.
cnt.Close
Set cnt = Nothing

End Sub

shades - send me a pm with Your e-mailaddress and I will send the workbooks to You.

Kind regards,
Dennis

 

[NateO]

I like this approach Dennis! Sql and RecordSet Objects are bloody fast with copious amounts of data.

Indeed the workbook is the database eh, one wants to connect here.

Re:

'Empty the SQL-string
stSQL = ""

Maybe:

let stSQL = Empty

Versus stacking the fundamental data type with a custom null string?

Nice work Dennis.

 

[XL-Dennis]

Nate,

Of course - Good point!

Yes, we are at least two here on the board who like the approach :wink:

Kind regards,
Dennis