Here's one way:

Dim nBoldArr(1 To 100, 1 To 2) As Long
Dim nEndBold As Long
Dim nCount As Long
Dim sStr As String

nCount = 1
With ActiveCell
sStr = .Text
nBoldArr(nCount, 1) = InStr(sStr, "<b")
Do While nBoldArr(nCount, 1) 0
nEndBold = InStr(nBoldArr(nCount, 1) + 3, sStr, "</b")
If nEndBold = 0 Then nEndBold = 32767
nBoldArr(nCount, 2) = nEndBold - nBoldArr(nCount, 1) - 3
sStr = Left(sStr, nBoldArr(nCount, 1) - 1) & _
Mid(sStr, nBoldArr(nCount, 1) + 3, nBoldArr(nCount, 2)) & _
Mid(sStr, nEndBold + 4)
nCount = nCount + 1
nBoldArr(nCount, 1) = InStr(sStr, "<b")
Loop
.Value = sStr
For nCount = nCount - 1 To 1 Step -1
.Characters(nBoldArr(nCount, 1), _
nBoldArr(nCount, 2)).Font.Bold = True
Next nCount
End With


In article ,
Matt Turner wrote:

Or is there a better way to do this?