In an Excel 2007 spreadsheet I want to find-replace with highlighting part of the text in a cell. Using find-replace reformats the entire cell though.
For ex
Maybe this would suit (be sure to select no more cells than necessary before running or this could take a while):
Sub FormatSelection()
Dim cl As Range
Dim SearchText As String
Dim StartPos As Integer
Dim EndPos As Integer
Dim TestPos As Integer
Dim TotalLen As Integer
On Error Resume Next
Application.DisplayAlerts = False
SearchText = Application.InputBox _
(Prompt:="Enter string.", Title:="Which string to format?", Type:=2)
On Error GoTo 0
Application.DisplayAlerts = True
If SearchText = "" Then
Exit Sub
Else
For Each cl In Selection
TotalLen = Len(SearchText)
StartPos = InStr(cl, SearchText)
TestPos = 0
Do While StartPos > TestPos
With cl.Characters(StartPos, TotalLen).Font
.FontStyle = "Bold"
.ColorIndex = 3
End With
EndPos = StartPos + TotalLen
TestPos = TestPos + EndPos
StartPos = InStr(TestPos, cl, SearchText, vbTextCompare)
Loop
Next cl
End If
End Sub
Should embolden and colour Red. Changes are not overwritten if macro is rerun. Comment out .ColorIndex = 3 if not to change colour.
(Based on @Skip Intro's pointer to SO15438731 question with amendment and some code from SO10455366 answer.)
This is what worked great for me:
Selected cells in Excel (I selected 1266 at a time--don't know if there's really any limit)
Clicked on COPY
Opened a blank word file and clicked on PASTE
Used CNTL+H to get Find & Replace
Entered the characters to find and the characters to replace, adding any formatting desired and selected Replace All (the process took less than 2 seconds)
Selected Edit-Select-Select All in the Word file, then held the shift key and pressed the left arrow (I think not doing this would add a row to the next operation)
Went back into Excel and, in a spare area, selected Paste - Keep Source Formatting option
That put exactly what I wanted into Excel. From there I could move it wherever I wanted it.
The absolute EASIEST WAY to do this with the standard Find & Replace CTRL+F Command is to just "temporary" add-in the "Calibri Font" Character • aka. "black bullet dot"
like this: • sample •
from the Insert Tab --> Symbols --> Calibri Font --> and at the very end)
Thus you can make it much easier to the eyes to read over many rows of excel data,
and easily also later remove it back again to the original with simply again a Find & Replace reversed.
Hope this helps someone, it sure helped my eyes to scan over quicker.
OLD RESPONSE
the easy non-programming way to do this, is to:
paste the text into MS Word
Then run the Find & Replace (CTRL+F) there (with the custom formatting changes at the bottom left button under "More > >" and then "Format" to your need customized) - which will then do all the changes perfectly...
and then rather than doing a PASTE SPECIAL into Excel (via the Home Tab --> Paste --> Paste Special --> Paste as HTML (so to retain the formatting) (which can and is too memory intensive and too slow for anything above like 1000 rows)
it is better to simply "Save as" from Word the document into a RTF-File, and then just re-import that file into Excel via the simple "Open File".
Excel has a pretty good "repeating pattern cell structuring" recognition, but of course, this workaround may not work perfectly in reproducing the desired cell division every single time, but it should maintain the cell order nevertheless most of the time.
So much for the simple way to do it, until Microsoft stops limiting an option to "highlight/bold" a found-result-text WITHIN a cell, rather than always bolding the entire cell.
Greetings Marko
To make the search item case agnostic you can use:
Sub FormatSelection()
Dim cl As Range
Dim SearchText As String
Dim StartPos As Integer
Dim EndPos As Integer
Dim TestPos As Integer
Dim TotalLen As Integer
On Error Resume Next
Application.DisplayAlerts = False
SearchText = Application.InputBox _
(Prompt:="Enter string.", Title:="Which string to format?", Type:=2)
On Error GoTo 0
Application.DisplayAlerts = True
If SearchText = "" Then
Exit Sub
Else
For Each cl In Selection
TotalLen = Len(SearchText)
StartPos = InStr(Ucase(cl), Ucase(SearchText))
TestPos = 0
Do While StartPos > TestPos
With cl.Characters(StartPos, TotalLen).Font
.FontStyle = "Bold"
.ColorIndex = 3
End With
EndPos = StartPos + TotalLen
TestPos = TestPos + EndPos
StartPos = InStr(TestPos, cl, SearchText, vbTextCompare)
Loop
Next cl
End If
End Sub