How can I replace a single word or section in a cell in for example of a
red bold format and avoid changing the format of the entire cell to red
bold also.


--
pnmaggs2001
------------------------------------------------------------------------
pnmaggs2001's Profile: http://www.excelforum.com/member.php...o&userid=27746
View this thread: http://www.excelforum.com/showthread...hreadid=472567

Land the cell pointer on the cell in question. You'll see the text for
that cell in the formula bar at the top of the screen: highlight the
word and click the font format button, then select red color. Only the
word you highlighted will change to red.

Saved from a previous post, but this one has some wordwrap problems fixed:

I think you'd have to keep track of each character's font attributes.

This works very slowly, but works:

Option Explicit
Option Compare Text

Type myCharacter
myChar As String
myLen As Long
myName As String
myFontStyle As String
mySize As Double
myStrikethrough As Boolean
mySuperscript As Boolean
mySubscript As Boolean
myOutlineFont As Boolean
myShadow As Boolean
myUnderline As Long
myColorIndex As Long
End Type
Sub testme()

Application.ScreenUpdating = False

Dim myWords As Variant
Dim myNewWords As Variant
Dim myRng As Range
Dim foundCell As Range
Dim iCtr As Long 'word counter
Dim lCtr As Long 'length of string counter
Dim cCtr As Long 'character counter
Dim usedChars As Long
Dim FirstAddress As String
Dim AllFoundCells As Range
Dim myCell As Range
Dim myStr As String
Dim myCharacters() As myCharacter

myWords = Array("xxx", "yy")
myNewWords = Array("qqqq", "BBBB")

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(.Cells.Count))

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
ReDim myCharacters(1 To Len(myCell.Value))
usedChars = 0
cCtr = 1
lCtr = 0
Do
usedChars = usedChars + 1
With myCell.Characters(cCtr, 1)
myCharacters(usedChars).myName = .Font.Name
myCharacters(usedChars).myFontStyle = .Font.FontStyle
myCharacters(usedChars).mySize = .Font.Size
myCharacters(usedChars).myStrikethrough _
= .Font.Strikethrough
myCharacters(usedChars).mySuperscript _
= .Font.Superscript
myCharacters(usedChars).mySubscript = .Font.Subscript
myCharacters(usedChars).myOutlineFont _
= .Font.OutlineFont
myCharacters(usedChars).myShadow = .Font.Shadow
myCharacters(usedChars).myUnderline = .Font.Underline
myCharacters(usedChars).myColorIndex = .Font.ColorIndex

If Mid(myCell.Value, cCtr, Len(myWords(iCtr))) _
= myWords(iCtr) Then
myCharacters(usedChars).myChar = myNewWords(iCtr)
myCharacters(usedChars).myLen _
= Len(myNewWords(iCtr))
cCtr = cCtr + Len(myWords(iCtr))
lCtr = lCtr + Len(myNewWords(iCtr))
Else
myCharacters(usedChars).myChar _
= Mid(myCell.Value, cCtr, 1)
myCharacters(usedChars).myLen = 1
cCtr = cCtr + 1
lCtr = lCtr + 1
End If
If cCtr Len(myCell.Value) Then Exit Do
End With
Loop

myStr = Space(lCtr)
lCtr = 1
For cCtr = 1 To usedChars
Mid(myStr, lCtr, myCharacters(cCtr).myLen) _
= myCharacters(cCtr).myChar
lCtr = lCtr + myCharacters(cCtr).myLen
Next cCtr
myCell.Value = myStr
cCtr = 1
lCtr = 1
Do
With myCell.Characters(lCtr, myCharacters(cCtr).myLen)
.Font.Name = myCharacters(cCtr).myName
.Font.FontStyle = myCharacters(cCtr).myFontStyle
.Font.Size = myCharacters(cCtr).mySize
.Font.Strikethrough _
= myCharacters(cCtr).myStrikethrough
.Font.Superscript = myCharacters(cCtr).mySuperscript
.Font.Subscript = myCharacters(cCtr).mySubscript
.Font.OutlineFont = myCharacters(cCtr).myOutlineFont
.Font.Shadow = myCharacters(cCtr).myShadow
.Font.Underline = myCharacters(cCtr).myUnderline
.Font.ColorIndex = myCharacters(cCtr).myColorIndex
End With
lCtr = lCtr + myCharacters(cCtr).myLen
cCtr = cCtr + 1
If lCtr Len(myStr) Then
Exit Do
End If
Loop
Next myCell
End If
Next iCtr

Application.ScreenUpdating = True

End Sub


pnmaggs2001 wrote:

How can I replace a single word or section in a cell in for example of a
red bold format and avoid changing the format of the entire cell to red
bold also.

--
pnmaggs2001
------------------------------------------------------------------------
pnmaggs2001's Profile: http://www.excelforum.com/member.php...o&userid=27746
View this thread: http://www.excelforum.com/showthread...hreadid=472567

--

Dave Peterson

How do I go about using the Macro once I have copied and pasted the
text? Excel asks for xxx and yyy values??


--
pnmaggs2001
------------------------------------------------------------------------
pnmaggs2001's Profile: http://www.excelforum.com/member.php...o&userid=27746
View this thread: http://www.excelforum.com/showthread...hreadid=472567