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

 

[parry]

That fits well with your idea about replacing in chunks. If the chuncks are big autofilter has an advantage,
and if the chunks are small search and replace is the winner.

Cheers thanks Tommy. It's always nice to have different ideas so that if this situation occurs for yourself you have a number of ideas from the get go. It will be interesting to see if there was any real benefit of one operation over another rather than, as I suspect, they will be much the same. I think Ponsy is right regarding one operation vs another that it depends largely on how the data is organised and how much data your dealing with as well I suppose.

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

I agree Mike! Personally I would store in a hidden sheet and either read from the range directly or read into an array and work from the array if I needed to do a lot of operations. Shades had already hard coded so I left it that way but I should have mentioned this option.

 

[Legacy 21301]

If the names are stored in columns A & B of Sheet2 and the names to be checked and replaced are in column A of Sheet1, another way is :-

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

Whether or not this would be quicker would depend upon how much data to be procssed.

 

[XL-Dennis]

Hi guys

I enjoy reading this thread and the way it progress. In order to expand the knowledge of all the possibile solutions for the issue being discussed I would like to contribute with the below example.

I agree with parry about using arrays, with PN for that different situations require different solutions as well as Mike's opinion about the benefit of not hardcodeing. Tommy's approach can be very powerful and is useful where it can be applied.

In order to run the below procedure You need to set up a reference to the Microsoft ActiveX Data Object Library x.x via the command Tools | Reference... in the VB-editor.

I also built a solution on ADO.Net but decided to not publishing here because most of You does no have access to this library. Actually it works even better then with ADO :wink:

Unfortunately there are some limitations when it comes to the SQL-statement UPDATE however if we understand the need for setting up the data we can use it successfully.

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 cmd As ADODB.Command
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

Set cnt = New ADODB.Connection
Set cmd = New ADODB.Command

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

Application.ScreenUpdating = False

For i = LBound(vaSource) To UBound(vaSource)
stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & stFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"

'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.ConnectionString = stCon
cnt.Open
cmd.ActiveConnection = cnt
cmd.CommandText = stSQL
cmd.Execute

cnt.Close
stCon = ""
stSQL = ""
Next i

Application.ScreenUpdating = True

'Cleaning up.
Set cmd = Nothing
Set cnt = Nothing

End Sub

Edit: The stSQL-variables content should read:
"UPDATE [Name$] SET Company =" & " '" & vaTarget(i, 1) & "'" _
& " WHERE Company =" & "'" & vaSource(i, 1) & "'"


Kind regards,
Dennis

 

[Tommy Bak]

Hi
This is getting interesting.
Ponsy Nob's is simple and fast and taking advantage of excel's buit in functions. I like that.

XL-dennis's is very advanced ( for me as I just recently discoved how to query worksheets with SQL).
I have a question for XL-dennis.
Why is it nessecary to open and close the connection inside the loop ?
I would have thought that it was possible to open the connection once and then close it just before End Sub


Here is another approach, this time with reference to MS Scripting Runtime
The two columns with original and replacementvalues are on sheet Data.
It's using the Dictionary-object, which I found is very, very fast for performing string-checks. I could though have made use of the Collection-object, but I found that a little slower.
This one is really f a s t , no mather the size of the data or number of replacementvalues.

Sub DictionaryModel()
    Dim dctCompany As New Dictionary
    Dim rgReplace As Range
    Dim vaReplace As Variant
    Dim C As Range, start As Long, x As Long, LastRow As Long
    Dim IndexCol As Range

    Set IndexCol = Application.InputBox(prompt:="Point out the header in the column for replacement", Type:=8)
    start = Timer
    LastRow = Cells(65536, IndexCol.Column).End(xlUp).Row
    Set rgReplace = Range(IndexCol.Offset(1, 0), Cells(LastRow, IndexCol.Column))

    For Each C In Sheets("Data").Range("A2:A" & Sheets("data").Range("A65536").End(xlUp).Row)
        dctCompany.Add Key:=CStr(C.Value), Item:=CStr(C.Offset(0, 1).Value)
    Next

    vaReplace = rgReplace

    For x = 1 To UBound(vaReplace, 1)
        If dctCompany.Exists(vaReplace(x, 1)) = True Then vaReplace(x, 1) = dctCompany.Item(vaReplace(x, 1))
    Next

    rgReplace = vaReplace

    Set dctCompany = Nothing
    Set rgReplace = Nothing
    Set vaReplace = Nothing
    MsgBox Timer - start
End Sub

 

[XL-Dennis]

Hi Tommy et al,

The above example originated from a solution which involved several workbooks (available at OzGrid) and I only adjusted it to suite the thread here.

You notice is correct and I made some more revision and ended up with the below example.

As a general rule we shouldn´t be connected with a database no more then necessary but in this case I believe it will not have any particular impact on performance.

However I can´t see the reason why it should be treated as an advanced solution?

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

 

[Tommy Bak]

Hi XL-dennis

However I can´t see the reason why it should be treated as an advanced solution?

Please don't take this as an offence, dennis. It's maybe only to me it seems advanced

regards
Tommy Bak

 

[parry]

Please don't take this as an offence, dennis. It's maybe only to me it seems advanced

regards
Tommy Bak

Nope, your not alone - its over my head.

Its all relative though, its just because I dont understand SQL but theres not a huge amount of code. Childs play for a SQL king like Dennis.

 

[XL-Dennis]

Hi guys,

No no - I was just curious about it :wink:

OK, it is complicated to read the strings but other then that it is rather straightforward.

Anyway, back to the issue

Tommy's latest contribution is fast and as well a slick solution

It's indeed a good solution and one of the best I´ve seen for using the dictionary-object with XL

Again it shows that we are moving more and more forward to a situation where we use external tools (i e libraries et al) to solve internal issues so to speak.

I hope shade will have the possibility to add more information so we can implement the solutions for his real issue as well.

Kind regards,
Dennis

 

[XL-Dennis]

parry et all,

Since I know You like to learn I picked up on of the good URL for learning more about SQL:

http://www.1keydata.com/sql/sql.html

If You have a copy of Access available then I suggest You to play around with creating questions and view the raw SQL-statements.

You may also play around with how to execute created Access-questions inside XL (this might be advanced but fun to explore).

And the best life of knowledge is when it is shared :wink:

Kind regards,
Dennis

 

[parry]

Great link that. Thanks Dennis.