VBA Express : Excel - Find and Replace Entire Words Only

Excel

Find and Replace Entire Words Only

Ease of Use

Easy

Version tested with

2000, 2003

Submitted by:

byundt

Description:

Finds and replaces only entire words, without needing to indicate trailing or preceding spaces, etc.

Discussion:

If you are editing a database, the Find and Replace menu item captures both words and word fragments. If you add a leading or trailing space to the Find string, it misses words at the beginning or end of the cell. It also misses words followed by punctuation (commas or periods). The wildcard capability in Excel does not have the sophistication to deal with these problems. While you could construct formulas for the task, they can handle only one Find/Replace operation at a time--and you would also need to add a column for the intermediate results. This resolves all of those problems for you. There are two macros: Replacer wipes out all formulas in the selected range. Replacer2 saves those formulas that don't return a result containing a string on the Find list. Regular expressions (part of VB Script, also known as RegExp) have the power needed for this task. They are supported on any computer that has Internet Explorer 5 or later.

Code:

instructions for use

			Sub Replacer() 
     'Does a Find and Replace on whole words throughout the selected range. Uses a table of _
    Find And Replace strings taken from Sheet2 columns A And B _ 
    Uses regular expressions For search To make sure found strings are complete words _ 
    Uses arrays For speed For range To be searched And For source of Find/Replace strings. _ 
    Note: will wipe out all formulas In the selected range! 
    Dim RgExp As Object 
    Dim rg As Range 
    Dim X As Variant, Y As Variant 
    Dim i As Long, j As Long, k As Long, nColumns As Long, nFindReplace As Long, nRows As Long 
    Dim FindReplacePrompt As String 
    FindReplacePrompt = "I couldn't find the Find/Replace strings at Sheet2!A1:Bxx. Please select them now." & _ 
    "  No blanks allowed in first column!" 
     
    If Selection.Cells.Count = 1 Then 
        If Selection = "" Then 
            MsgBox "Please select some cells to run the macro on, then try again" 
            Exit Sub 
        Else 
            ReDim X(1 To 1, 1 To 1) 
            X(1, 1) = Selection 
        End If 
    Else 
        X = Selection.Value 
    End If 
     
     'Populate the array variable Y with Find/Replace strings. Default source is Sheet2, A1:Bxx
    On Error Resume Next 
    Set rg = Worksheets("Sheet2").Range("A1") 
    If rg Is Nothing Then 
        Set rg = Application.InputBox(prompt:=FindReplacePrompt, Title:="Source of Find/Replace strings", Type:=8) 
        If rg Is Nothing Then Exit Sub 
    Else 
        If rg.Cells(1, 1) = "" Then 
            Set rg = Application.InputBox(prompt:=FindReplacePrompt, Title:="Source of Find/Replace strings", Type:=8) 
            If rg Is Nothing Then Exit Sub 
        Else 
            Set rg = Range(rg, rg.End(xlDown).Offset(0, 1)) 
        End If 
    End If 
    On Error GoTo 0 
    Y = rg.Value 
    nFindReplace = UBound(Y) 
     
    Set RgExp = CreateObject("VBScript.RegExp") 
    With RgExp 
        .Global = True 
         '.IgnoreCase = True  'True if search is case insensitive. False otherwise
    End With 
     
    nRows = UBound(X) 
    nColumns = UBound(X, 2) 
    For i = 1 To nFindReplace 
        RgExp.Pattern = "\b" & Y(i, 1) & "\b" 
        For j = 1 To nRows 
            For k = 1 To nColumns 
                X(j, k) = RgExp.Replace(X(j, k), Y(i, 2)) 
            Next k 
        Next j 
    Next i 
     
    Set RgExp = Nothing 
    Selection.Value = X 'Replace cell values with the edited strings
End Sub 
 
Sub Replacer2() 
     'Does a Find and Replace on whole words throughout the selected range. Uses a table of _
    Find And Replace strings taken from Sheet2 columns A And B _ 
    Uses regular expressions For search To make sure found strings are complete words _ 
    Loops through the cells To be searched using an array For source of Find/Replace strings _ 
    Tries To preserve As many formulas As possible (will wipe out formulas If the result _ 
    contains a String on the Find list). 
    Dim RgExp As Object 
    Dim cel As Range, rg As Range 
    Dim Y As Variant, tmp As Variant 
    Dim i As Long, nFindReplace As Long 
    Dim FindReplacePrompt As String 
    FindReplacePrompt = "I couldn't find the Find/Replace strings at Sheet2!A1:Bxx. Please select them now." & _ 
    "  No blanks allowed in first column!" 
     
    If Selection.Cells.Count = 1 And Selection.Cells(1, 1) = "" Then 
        MsgBox "Please select some cells to run the macro on, then try again." 
        Exit Sub 
    End If 
     
     'Populate the array variable Y with Find/Replace strings. Default source is Sheet2, A1:Bxx
    On Error Resume Next 
    Set rg = Worksheets("Sheet2").Range("A1") 
    If rg Is Nothing Then 
        Set rg = Application.InputBox(prompt:=FindReplacePrompt, Title:="Source of Find/Replace strings", Type:=8) 
        If rg Is Nothing Then Exit Sub 
    Else 
        If rg.Cells(1, 1) = "" Then 
            Set rg = Application.InputBox(prompt:=FindReplacePrompt, Title:="Source of Find/Replace strings", Type:=8) 
            If rg Is Nothing Then Exit Sub 
        Else 
            Set rg = Range(rg, rg.End(xlDown).Offset(0, 1)) 
        End If 
    End If 
    On Error GoTo 0 
    Y = rg.Value 
    nFindReplace = UBound(Y) 
     
    Set RgExp = CreateObject("VBScript.RegExp") 
    With RgExp 
        .Global = True 
         '.IgnoreCase = True  'True if search is case insensitive. False otherwise
    End With 
     
    Application.ScreenUpdating = False 
    For Each cel In Selection 
        For i = 1 To nFindReplace 
            RgExp.Pattern = "\b" & Y(i, 1) & "\b" 
            tmp = RgExp.Replace(cel.Value, Y(i, 2)) 
            If cel.HasFormula Then 
                If cel.Value <> tmp Then cel.Formula = tmp 
            Else 
                cel.Value = tmp 
            End If 
        Next i 
    Next cel 
     
    Set RgExp = Nothing 
    Application.ScreenUpdating = True 
End Sub

How to use:

Copy the code above.
Hit ALT + F11 to open the VBA Editor (VBE).
Choose your workbook at left and hit Insert-Module from the menu.
Paste the code into the code window that appears at right.
Hit the Save diskette and close the VBE.
Build a list of Find and Replace strings. The macro assumes that these strings are located in Sheet2, column A containing Finds and Column B containing Replaces; begin in row 1, and don't leave any blank rows. The list may include both text and numbers, and is case-sensitive.

Test the code:

Select the range of data on which to run the Find/Replace task.
Go to Tools-Macro-Macros and double click Replacer or Replacer2.

Sample File:

FindReplaceEntireWords.zip 13KB

Approved by mdmackillop

This entry has been viewed 222 times.