VBA Express : Excel - Ultra Fast Large Scale Replace

Excel

Ultra Fast Large Scale Replace

Ease of Use

Hard

Version tested with

2000, 2002, 2003

Submitted by:

shades

Description:

The normal Excel Find/Replace works well unless the number of changes is significant. This method uses the Dictionary Object Model to effect a very fast Find/Replace on a column of many entries. This approach allows you to make multiple changes in seconds rather than minutes.

Discussion:

Perhaps you receive data from outside sources and the names are not consistent across all vendors. One way to make quick, consistent changes so that all names match is to use the Dictionary Object Model replacement method. My best performance for changes is this: Rows: 29,793 Replaced Different Names: 154 Time: 3.14 seconds

Code:

instructions for use

			Sub OpenUltraReplace() 
     ' Opens UltraReplace.xls
    ChDir "C:\Documents and Settings\myFolder" 
    Workbooks.Open Filename:= _ 
    "C:\Documents and Settings\myFolder\UltraReplace.xls" 
    ActiveWindow.ActivateNext 
End Sub 
 
Sub ChgA() 
     ' TommyBak developed this on mrexcel.com
     ' requires MS Scripting Runtime (In VBE Window Tools > Reference)
     ' this code is actually in the UltraReplace.xls file already
    Dim dctCompany 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("ChgA") 
        For Each C In .Range("A2:A" & .Range("A65536").End(xlUp).Row) 
            dctCompany.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 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 
End Sub

How to use:

Put the OpenUltraReplace code into a module in the VBE window of the Personal.xls workbook. In VBE, go to Tools > Reference, and on the left scroll down to find MS Scripting Runtime. Be sure to check the box next to it. Click OK.
Place the UltraReplace.xls file in a folder named "myFolder" in the Documents and Settings Folder. (Later you can move this file if you desire, but be sure to change the file path in the code above OpenUltraReplace.) The UltraReplace.xls file is where you store the changes you want to make. In this case, the worksheet ChgA includes in Column A the city names as originally given (OriginalName), and in Column B, the city names as they should appear (NewName, which are the replacement values). If you use this approach, then all your changes are made on this worksheet, not in code. Also, you can add more change worksheets as needed (I have 15 worksheets). But for each additional worksheet, you will need to copy code ChgA (code above), and make appropriate changes to worksheet names.
Place SampleReplace.xls file in any easily accessible place (this will not matter because it will eventually be any xls file you use). This will be the file to test the Find/Replace macros, and you will change the names in Column A of SampleReplace.xls to the new names from Column B of UltraReplace.xls.

Test the code:

Open file, SampleReplace.xls. Then run code, OpenUltraReplace (above), by going to Tools > Macro > Macros and in resulting dialog choose "OpenUltraReplace" and click run. This will open this UltraReplace.xls, but will also make SampleReplace.xls the active workbook.
In SampleReplace.xls, select worksheet ChgA. and select cell A1.
To change the names of the cities to a standard name, go to Tools > Macro > Macros and choose the macro "UltraReplace!ChgA" (or it may appear as just "ChgA") and click Run. This will bring up a dialog box, in which you select the header cell for the column. In this case, select cell A1 and click OK. This will change all the names in column A based on the Column B values in worksheet ChgA of UltraReplace.xls.
If this works, drag a blank "New Menu Item" to the menu bar (I name it Replace) - this item does nothing except dropdown to the other menu items. Then drag another New Menu Item and put it as a submenu under Replace Menu and assign the macro (OpenUltraReplace) to it. This will open the UltraReplace.xls file. While UltraReplace is still open, assign the two macros in UltraReplace.xls (ChgA and ChgB) to submenus as well. Once UltraReplace.xls is open, then these macros will run the code to actually replace items. As you add more worksheets and more code, you can add to this menu.

Sample File:

UltraReplace.zip 371.82KB

Approved by mdmackillop

This entry has been viewed 393 times.