Format cell characters with Find method (VBA)

[Craig__]

How can I modify the code below to format all characters from the found word "over" right through to the last character in the cell. Neither the number of characters before or after the found word are constant, so using something like Start:=11, Length:=27 would not work.

Thanks for your help.


Sub Format_Characters_In_Found_Cell()

x = "over"
Set Found = Cells.Find(what:=x, LookIn:=xlValues, LookAt:=xlPart)
If Found Is Nothing Then
MsgBox x & " could not be found.", , " "
Else

'Format last character in found cell
' Found.Characters(Start:=Len(Found), Length:=Len(ActiveCell)).Font.ColorIndex = 5

'Format all characters in found cell
' Found.Characters(Start:=Len(ActiveCell), Length:=Len(Found)).Font.ColorIndex = 5

'Format 11th character in found cell through to last character in found cell
' Found.Characters(Start:=11, Length:=Len(ActiveCell)).Font.ColorIndex = 5

End If
End Sub

 

[jbeaucaire]

Option Explicit

Sub Format_Characters_In_Found_Cell()
Dim Found As Range, x As String

x = "over"
On Error Resume Next
Set Found = Cells.Find(what:=x, LookIn:=xlValues, LookAt:=xlPart)

If Not Found Is Nothing Then
   'Format from "x" to the end of the cell
    Found.Characters(Start:=InStr(1, Found.Text, x), Length:=Len(Found)).Font.ColorIndex = 5
Else
    MsgBox x & " could not be found.", , " "
End If

End Sub

 

[jbeaucaire]

If you'd like this macro to do that for EVERY cell on the sheet that matches the search value:

Option Explicit

Sub Format_Characters_In_Found_Cell()
Dim Found As Range, x As String, FoundFirst As Range

x = "over"
On Error Resume Next
Set Found = Cells.Find(what:=x, LookIn:=xlValues, LookAt:=xlPart)

If Not Found Is Nothing Then
    Set FoundFirst = Found
    Do
      'Format from "x" to the end of the cell
         Found.Characters(Start:=InStr(1, Found.Text, x), Length:=Len(Found)).Font.ColorIndex = 5
         Set Found = Cells.FindNext(Found)
    Loop Until FoundFirst.Address = Found.Address
Else
    MsgBox x & " could not be found.", , " "
End If

End Sub

 

[VoG]

Try

Sub Format_Characters_In_Found_Cell()
Dim x As String, Found As Range
x = "over"
Set Found = Cells.Find(what:=x, LookIn:=xlValues, LookAt:=xlPart)
If Found Is Nothing Then
    MsgBox x & " could not be found.", , " "
Else
    Found.Characters(InStr(Found, x) + Len(x) + 1, Len(Found) - InStr(Found, x) - Len(x)).Font.ColorIndex = 5
End If
End Sub

 

[Craig__]

<!--[if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:PunctuationKerning/> <w:ValidateAgainstSchemas/> <w:SaveIfXMLInvalid>false</w:SaveIfXMLInvalid> <w:IgnoreMixedContent>false</w:IgnoreMixedContent> <w:AlwaysShowPlaceholderText>false</w:AlwaysShowPlaceholderText> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> <w:DontGrowAutofit/> </w:Compatibility> <w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel> </w:WordDocument> </xml><![endif]--><!--[if gte mso 9]><xml> <w:LatentStyles DefLockedState="false" LatentStyleCount="156"> </w:LatentStyles> </xml><![endif]--><!--[if gte mso 10]> <style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0in 5.4pt 0in 5.4pt; mso-para-margin:0in; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman"; mso-ansi-language:#0400; mso-fareast-language:#0400; mso-bidi-language:#0400;} </style> <![endif]--> Many thanks jbeaucaire. That's absolutely perfect. Your 2nd example is also very useful.


Cheers

 

[Craig__]

Vog, just spotted your solution. Thank you so much for your help too.

Regards -
Craig

 

[Phil Smith]

Could this code be adapted to work on just a single character found within a cell, i.e. "£", and nothing else?

I have some cells containing dates, of which some have a "£" then two spaces immediately before the date, followed by two spaces then another "£", showing that date as being Pay Day, for example:

"£ 11 Nov £"

I wish to change ONLY the "£" to bold and red and nothing else.

I am OK with the formatting part of the code, I am just not too sure how, or if, this code could be changed to do work with the individual characters.

I have another avenue of enquiry open on this using a different method. That is at http://www.mrexcel.com/forum/showthread.php?t=378553&highlight=Partial+Change+font+colour .

However, for some reason that code is not working for me, so when I found this, I wondered if this might.

Thanks.

Phil

 

[jbeaucaire]

Like so:

Sub Format_Characters_In_Found_Cell()
Dim Found As Range, x As String, FoundFirst As Range

x = "£"
On Error Resume Next
Set Found = Cells.Find(what:=x, LookIn:=xlValues, LookAt:=xlPart)

If Not Found Is Nothing Then
    Set FoundFirst = Found
    Do
      'Format "x"
        With Found.Characters(Start:=InStr(Found.Text, x), Length:=Len(x))
            .Font.ColorIndex = 3
            .Font.Bold = True
        End With
        With Found.Characters(Start:=InStrRev(Found.Text, x), Length:=Len(x))
            .Font.ColorIndex = 3
            .Font.Bold = True
        End With
        Set Found = Cells.FindNext(Found)
    Loop Until FoundFirst.Address = Found.Address
Else
    MsgBox x & " could not be found.", , " "
End If

End Sub

 

[Craig__]

Would it be possible to modify this:

'Format from "x" to the end of the cell
Found.Characters(Start:=InStr(1, Found.Text, x), Length:=Len(Found)).Font.ColorIndex = 5

so that all characters from the found word through to the first character at the beginning of the cell are formatted?

 

[jbeaucaire]

Care to show me with some text examples?