Converting <b> to bold in excel

[Matt]

I have some data that I pull from an external database and just
display it in an excel cell using VB. I currently strip out all of
the html tags and convert the <br> to line feeds. That works great.
But I would like to convert <b> tags within the cell to bold.

So my cell might contain: "This is a <b>formatting</b> test."

I am trying to figure out a way to make the word formatting in the
example above bold. Can anyone help?

Thanks,
Matt

 

[JE McGimpsey]

One way:

This assumes there's only one <b></b> pair - you could use recursion if
you expect more than one.

Dim str As String
Dim nBold As Long
Dim nEndBold As Long
Dim nChars As Long
With ActiveCell
str = .Text
nBold = InStr(str, "<b>")
If nBold > 0 Then
nEndBold = InStr(str, "</b>")
If nEndBold = 0 Then nEndBold = 32767
nChars = nEndBold - nBold - 3
str = Replace(Replace(str, "<b>", ""), "</b>", "")
.Value = str
.Characters(nBold, nChars).Font.Bold = True
End If
End With

For XL97 or MacXL, replace Replace with Application.Substitute

 

[Tom Ogilvy]

Turn on the macro recorder

Select a cell with text. go to the formula bar. Highlight just a subset of
the text (similar to your example). go to format=>Cells and select the font
tab. Select Bold. Click OK and then hit enter to end the editing of the
cell. Turn off the macro recorder.

You will see that the code recorded uses the characters method to set the
formatting options for a subset of a string. You should be able to adapt
this to your situation.

 

[Helen Trim]

This bit of code works for an individual cell:

Sub OneLine()
Dim First As Integer, Last As Integer, Length As Integer

First = InStr(ActiveCell.Text, "<b>")
If First > 0 Then
Last = InStr(ActiveCell.Text, "</b>")
If Last > 0 Then
ActiveCell.Replace What:="<b>", Replacement:=""
ActiveCell.Replace What:="</b>", Replacement:=""
Length = Last - First - 3
ActiveCell.Characters(Start:=First,
Length:=Length).Font.Bold = True
End If
End If

End Sub

HTH
Helen

 

[Matt Turner]

Thanks for the quick response. Your code works great, but I have one
followup question. I am trying to convert the code to work for multiple
occurances of <b>&</b> pairs. This is what I did:


**********************************************
Dim str As String
Dim nBold As Long
Dim nEndBold As Long
Dim nChars As Long
With ActiveCell
str = .Text
nBold = InStr(1, str, "<b>")
Do While (nBold > 1)
If nBold > 0 Then
str = .Value
nEndBold = InStr(nBold, str, "</b>")
If nEndBold = 0 Then nEndBold = 32767
nChars = nEndBold - nBold - 3
.Characters(nBold + 3, nChars).Font.Bold = True
End If
nBold = InStr(nBold + 1, str, "<b>")
Loop
.Value = Replace(Replace(.Value, "<b>", ""), "</b>", "")
End With
***********************************************
When it the code exits the loop the cell is formatted with all of the
applicable text bolded, but the <b> and </b> tags are still there. And
once I do the replace function all of the bolded text becomes unbolded.
Is there away to do the replace function without changing the existing
formatting of the cell. Or is there a better way to do this?

Thanks again,
Matt

 

[Dave Peterson]

the only way I could do it was to find out where those <b>'s were and then do
them all at once:

Option Explicit
Sub testme01()

Dim str As String
Dim nBold() As Long
Dim nEndBold() As Long
Dim nChars() As Long
Dim nTimes As Long
Dim iCtr As Long

With ActiveCell
str = .Text
nTimes = (Len(str) - Len(Replace(str, "<b>", ""))) / Len("<b>")
If nTimes = 0 Then
'do nothing
Else
ReDim nBold(1 To nTimes)
ReDim nEndBold(1 To nTimes)
ReDim nChars(1 To nTimes)

For iCtr = 1 To nTimes
nBold(iCtr) = InStr(str, "<b>")
nEndBold(iCtr) = InStr(nBold(iCtr), str, "</b>")
If nEndBold(iCtr) = 0 Then
nEndBold(iCtr) = 32767
End If
nChars(iCtr) = nEndBold(iCtr) - nBold(iCtr) - 3
str = Replace(Replace(str, "<b>", "", 1, 1), "</b>", "", 1, 1)
Next iCtr

str = Replace(str, "</b>", "")
.Value = str

For iCtr = 1 To nTimes
.Characters(nBold(iCtr), nChars(iCtr)).Font.Bold = True
Next iCtr

End If
End With
End Sub

 

[JE McGimpsey]

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