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]

Nate,

Of course - Good point!

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

Kind regards,
Dennis

Maybe the rest of us just dont appreciate it yet. I must give it a crack but im too lazy at present.

btw, NateO why arent you using your beloved vbNullString? See I do listen

 

[XL-Dennis]

parry,

I can only speak for myself but I´m quite bored with working with XL from a strictly internal perspective. That's why I find it interesting to incorporate external techniques like ADO.

Yes, they differ a lot from the usual XL-approacj and require at least a basic understanding of the objects and the structure they have.

The good part that different approaches are viewed & discussed is that everyone here on the board can pick and choose different alternatives. Not necessarily the fastest one but the one that appeal to You

Enjoy the numbers of approaches but don't get stressed.

Kind regards,
Dennis

 

[Legacy 21301]

Ponsy,

Tried your second code – worked perfectly (and appears to be very quick, although my test data was fairly small).

I just tried it with 40 different company names and a list of 40,000 rows all of which needed replacing.

The average run-time (based on 6 runs) was 1.72 seconds.

I was interested to see how this compared with the other methods, with all methods applied to the same data.

 

[NateO]

btw, NateO why arent you using your beloved vbNullString? See I do listen

Well, in this instance, the objective is to release the variable, versus assigning a value to it, albeit a null string (vbnullstring).

In VB 6, this will lead to a string data type returning to a null string, it's default value (IsEmpty(Var) will evaluate to false following the empty assignment), but it's the general method of releasing fundamental data types eh. Somewhat similar, conceptually (while very different), to releasing object data types (non fundamental) via Set myObj = Nothing (a solid defensive programming practice independant of scope).

I was interested to see how this compared with the other methods, with all methods applied to the same data.

I'm curious, did you make such a comparison?

 

[Legacy 21301]

[quote:9ebc603fe7="Ponsy]
I was interested to see how this compared with the other methods, with all methods applied to the same data.

I'm curious, did you make such a comparison?[/quote:9ebc603fe7]

No, I can't run all of them on the computer I'm using - which is why I was asking.

 

[Legacy 21301]

I doubt that anyone's interested but my computer produced average run-times (6 runs), based on 40 company names and 40,000 rows of data (all of which had to be replaced), as follows :-

Tommy Bak : 2.94 seconds
Ponsy Nob : 3.64 seconds

I think it is worth noting that Tommy Bak's solution works for text values only, whereas the Ponsy Nob solution works for text and numbers.

Also, Tommy Bak's very elegant method requires more than an elementary knowledge of VBA.

The PN method, however, requires only a "lesson one" knowledge of XL's native worksheet formulas (i.e. VLOOKUP) together with use of the macro recorder which requires no knowledge of VBA and which is basically idiot-proof.

I think that this illustrates the power of XL even in the hands of "quick-fix" users, and that this thread is a good example of how XL users can create efficient methods to do what they want from basic XL worksheet knowledge without having to learn VBA or to ask others for VBA solutions.

 

[shades]

I doubt that anyone's interested but my computer produced average run-times (6 runs), based on 40 company names and 40,000 rows of data (all of which had to be replaced), as follows :-

Tommy Bak : 2.94 seconds
Ponsy Nob : 3.64 seconds

That's my project for Monday/Tuesday.

I think it is worth noting that Tommy Bak's solution works for text values only, whereas the Ponsy Nob solution works for text and numbers.

Wasn't aware of that, but good to know. Thanks!

Also, Tommy Bak's very elegant method requires more than an elementary knowledge of VBA.

The PN method, however, requires only a "lesson one" knowledge of XL's native worksheet formulas (i.e. VLOOKUP) together with use of the macro recorder which requires no knowledge of VBA and which is basically idiot-proof.

I think that this illustrates the power of XL even in the hands of "quick-fix" users, and that this thread is a good example of how XL users can create efficient methods to do what they want from basic XL worksheet knowledge without having to learn VBA or to ask others for VBA solutions.

This goes back to my original macro - it still does the work but takes about 36 sec with the 40 names and 14,786 rows. Tommy's 2+ sec for all 236 names.

Now, I am really curious about using yours. I have developed other macros for people in the department that I try to make "idiot-proof" - guess I should hold myself to the same standard!

Really appreciate all the input on this question.

From one who is proving that being an idiot can be helpful for others, as well as myself!

 

[shades]

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

Okay, Ponsy, I tried yours and it was 4.3 sec for 243 companies and 14,486 rows. Very good! Thanks.

Okay, Dennis, you are next on the list.

 

[shades]

First, a major thank you to everyone who participated. ray: You gave me far more than I expected. And I am learning much from each contribution.

Second, a summary of sorts (but not sorted :wink: ).

Tommy's solution turned out to the fastest. However, I am less sure how I want to implement it; still thinking through that option.

For me the most understandable, and perhaps "fixable" from my perspective, is Ponsy Nob's solution (even though slightly slower - although at my age, anything seems fast!). I say "fixable" because if something does break, it seems to be about my level of stretching to make changes, adjust as necessary.

I will work on XL-Dennis's solution, but for now it is above me.

to everyone.

 

[shades]

Now for an update. After using ponsy's code for the past few months, about two weeks ago I began revising most of my macros (cleaning up, shortening, etc.). In that process I tried the Dicitonary Object method again (Tommy Bak's solution). Not only did it work as fast as ever, I played with it a bit and have developed a solution that allows me flexibility and retention of its power.

I now have a workbook entitled DictionaryReplace, and I have a worksheet for each kind of change I want to make. For instance, one sheet is "Cities". In column A I have all the long names/combination names, and in Column B I have the short names. Then I have a macro for that sheet:

Sub Cities()
' requires Dictionary Object and Microsoft Scripting Runtime (Tools > Reference)
    Dim Citiesdict As New Dictionary
    Dim rgReplace As Range
    Dim vaReplace As Variant
    Dim C As Range, 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)
    LastRow = Cells(65536, IndexCol.Column).End(xlUp).Row
    Set rgReplace = Range(IndexCol.Offset(1, 0), Cells(LastRow, IndexCol.Column))

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

    vaReplace = rgReplace

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

    rgReplace = vaReplace

    Set Citiesdict = Nothing
    Set rgReplace = Nothing
    Set vaReplace = Nothing
End Sub

Then another worksheet has the same set up with companies, and a corresponding macro. The only thing I have to change is what is bolded in the code above. Actually I have seven worksheets, and seven sets of code.

The other thing I did was to use the same idea for a filtering/deleting process. That is, in Column C of the above worksheet, I put the corresponding names of cities, but only those that I routinely use. Thus, if a city appears in the data, but is not necessary for me, I leave that cell blank in column C. Then I use this code:

Sub DeleteCities()
' Adapted here for replacing unwanted data with empty cell,
' References Column B in Cities, then replaces
' everything with what is in Column C. This puts "nothing" into those
' cities not necessary, then use DeleteEmpty macro for that column
    Dim Citiesdict As New Dictionary
    Dim rgReplace As Range
    Dim vaReplace As Variant
    Dim C As Range, x As Long, LastRow As Long
    Dim IndexCol As Range
    Dim myColm As Range
    
    Set IndexCol = Application.InputBox(prompt:="Point out the header in the column for replacement", Type:=8)
    LastRow = Cells(65536, IndexCol.Column).End(xlUp).Row
    Set rgReplace = Range(IndexCol.Offset(1, 0), Cells(LastRow, IndexCol.Column))

' Next section references Column B to find replace values, Col. C provides replace value
    With ThisWorkbook.Sheets("DeleteCities")
        For Each C In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
            Citiesdict.Add Key:=CStr(C.Value), Item:=CStr(C.Offset(0, 1).Value)
        Next
    End With

    vaReplace = rgReplace

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

    rgReplace = vaReplace

    Set Citiesdict = Nothing
    Set rgReplace = Nothing
    Set vaReplace = Nothing
    
End Sub

Thus, I can reuse the same worksheet, just adding columns for the type of work I want to do. Or adding a new worksheet.

Again, I tried all of these macros and the average time of replacement is ~ 2 sec; in the case of companies, that amounts to 240 company names and ~30,000 rows of data.

Now, I how I get to this workbook? I wrote a macro that opens this workbook and makes it not the active workbook. Then I put a new menu with this macro as the first item. Then each macro in the DictionaryReplace workbook is given a link to a new item under this menu. Thus, I have the workbook available with a click of the button, and the macros with another click. Everything works within a matter of seconds, and it doesn't clog up my Personal.xls file.