Use Find/Replace to reformat one word in cells?

[Ed from AZ]

I tried to highlight a column and use the Find/Replace to find "FAIL"
in the column and replace with "FAIL" in bold and red. It reformatted
the entire cell contents, rather than just the single word. Is there
a way to restrict the Replace action to just what is in the Find or
Replace box in Excel 2003?

Ed

 

[Dave Peterson]

Edit|replace won't work (as you've seen).

You could use a macro, though:

Saved from a previous post:

Option Explicit
Option Compare Text
Sub testme()

Application.ScreenUpdating = False

Dim myWords As Variant
Dim myRng As Range
Dim foundCell As Range
Dim iCtr As Long 'word counter
Dim cCtr As Long 'character counter
Dim FirstAddress As String
Dim AllFoundCells As Range
Dim myCell As Range

'add other words here
myWords = Array("widgets", "assemblies", "another", "word", "here")

Set myRng = Selection

On Error Resume Next
Set myRng = Intersect(myRng, _
myRng.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
On Error GoTo 0

If myRng Is Nothing Then
MsgBox "Please choose a range that contains text constants!"
Exit Sub
End If

For iCtr = LBound(myWords) To UBound(myWords)
FirstAddress = ""
Set foundCell = Nothing
With myRng
Set foundCell = .Find(what:=myWords(iCtr), _
LookIn:=xlValues, lookat:=xlPart, _
after:=.Cells(1))

If foundCell Is Nothing Then
MsgBox myWords(iCtr) & " wasn't found!"
Else
Set AllFoundCells = foundCell
FirstAddress = foundCell.Address
Do
If AllFoundCells Is Nothing Then
Set AllFoundCells = foundCell
Else
Set AllFoundCells = Union(foundCell, AllFoundCells)
End If
Set foundCell = .FindNext(foundCell)

Loop While Not foundCell Is Nothing _
And foundCell.Address <> FirstAddress
End If

End With

If AllFoundCells Is Nothing Then
'do nothing
Else
For Each myCell In AllFoundCells.Cells
For cCtr = 1 To Len(myCell.Value)
If Mid(myCell.Value, cCtr, Len(myWords(iCtr))) _
= myWords(iCtr) Then
With myCell.Characters(Start:=cCtr, _
Length:=Len(myWords(iCtr)))
.Font.ColorIndex = 3
.Font.Bold = True
End With
End If
Next cCtr
Next myCell
End If
Next iCtr
Application.ScreenUpdating = True

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

This portion:

With myCell.Characters(Start:=cCtr, _
Length:=Len(myWords(iCtr)))
.Font.ColorIndex = 3
.Font.Bold = True
End With

Changes the color and the boldness.

You may want to save first--so you can close without saving if you don't want to
keep the formatting changes. Remember this kind of formatting only works on
text cells--not formulas--not numbers.

 

[Ed from AZ]

Super, Dave!! Thanks very much!

Ed

Edit|replace won't work (as you've seen).

You could use a macro, though:

Saved from a previous post:

Option Explicit
Option Compare Text
Sub testme()

    Application.ScreenUpdating = False

    Dim myWords As Variant
    Dim myRng As Range
    Dim foundCell As Range
    Dim iCtr As Long 'word counter
    Dim cCtr As Long 'character counter
    Dim FirstAddress As String
    Dim AllFoundCells As Range
    Dim myCell As Range

    'add other words here
    myWords = Array("widgets", "assemblies", "another", "word", "here")

    Set myRng = Selection

    On Error Resume Next
    Set myRng = Intersect(myRng, _
                  myRng.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
    On Error GoTo 0

    If myRng Is Nothing Then
        MsgBox "Please choose a range that contains text constants!"
        Exit Sub
    End If

    For iCtr = LBound(myWords) To UBound(myWords)
        FirstAddress = ""
        Set foundCell = Nothing
        With myRng
            Set foundCell = .Find(what:=myWords(iCtr), _
                                LookIn:=xlValues, lookat:=xlPart, _
                                after:=.Cells(1))

            If foundCell Is Nothing Then
                MsgBox myWords(iCtr) & " wasn't found!"
            Else
                Set AllFoundCells = foundCell
                FirstAddress = foundCell.Address
                Do
                    If AllFoundCells Is Nothing Then
                        Set AllFoundCells = foundCell
                    Else
                        Set AllFoundCells = Union(foundCell, AllFoundCells)
                    End If
                    Set foundCell = .FindNext(foundCell)

                Loop While Not foundCell Is Nothing _
                    And foundCell.Address <> FirstAddress
            End If

        End With

        If AllFoundCells Is Nothing Then
            'do nothing
        Else
            For Each myCell In AllFoundCells.Cells
                For cCtr = 1 To Len(myCell.Value)
                    If Mid(myCell.Value, cCtr, Len(myWords(iCtr))) _
                              = myWords(iCtr) Then
                        With myCell.Characters(Start:=cCtr, _
                                  Length:=Len(myWords(iCtr)))
                            .Font.ColorIndex = 3
                            .Font.Bold = True
                        End With
                    End If
                Next cCtr
            Next myCell
        End If
    Next iCtr
    Application.ScreenUpdating = True

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:http://www.mvps.org/dmcritchie/excel/getstarted.htm

This portion:

                        With myCell.Characters(Start:=cCtr, _
                                  Length:=Len(myWords(iCtr)))
                            .Font.ColorIndex = 3
                            .Font.Bold = True
                        End With

Changes the color and the boldness.

You may want to save first--so you can close without saving if you don't want to
keep the formatting changes.  Remember this kind of formatting only works on
text cells--not formulas--not numbers.