Excel VBA Macro Replace Html Bold Tag With Bolded Text In Cell

Question

I have the following:

s = 1
f = 1
For i = 1 To UBound(Split(Range("B17").Value, "<b>"))
    s = InStr(f, Range("B17").Value, ("<b>"))
    f = InStr(s, Range("B17").Value, ("</b>"))
    Range("B17").Characters(s, f - s + 1).Font.FontStyle = "Bold"
Next i

This works to loop a cell and make all text betweentags bolded. However, this also still leaves behind the tags in the cell.

I need a way to bold between AND remove the tags from a specific cell. I tried to add:

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

BUT, this not only removed the tags, it also removed the bold font.

Is it possible to do this?

Answer 1

This code first notes the position of the tags before removing them. Then, in a separate loop, it applies bold font to the noted text positions.

Private Sub SetCharsBold(Cell As Range)
    ' 086

    Const Tag       As String = "<b>"       ' tag string: start
    Const Tend      As String = "</b>"      ' tag string: end
    Const Pstart    As Integer = 0          ' vector index of Pos()
    Const Pend      As Integer = 1          ' vector index of Pos()
    
    Dim Cv          As String               ' Cell value
    Dim Cnt         As Integer              ' instances of bold expressions
    Dim Pos()       As Variant              ' string positions: 0 = start, 1 = End
    Dim f           As Integer              ' loop counter: Cnt
    
    Cv = Cell.Value
    Cnt = (Len(Cv) - Len(Replace(Cv, Tag, ""))) / 3
    ReDim Pos(Cnt, Pend)
    For f = 1 To Cnt
        Pos(f, Pstart) = InStr(Cv, Tag)
        Cv = Left(Cv, Pos(f, Pstart) - 1) & Mid(Cv, Pos(f, Pstart) + Len(Tag), Len(Cv))
        Pos(f, Pend) = InStr(Cv, Tend) - 1
        Cv = Left(Cv, Pos(f, Pend)) & Mid(Cv, Pos(f, Pend) + Len(Tend) + 1, Len(Cv))
    Next f
    
    With Cell.Offset(18)
        .Font.Bold = False
        .Value = Cv
        For f = 1 To Cnt
            .Characters(Pos(f, Pstart), Pos(f, Pend) - Pos(f, Pstart) + 1).Font.Bold = True
        Next f
    End With
End Sub 

I thought it's a bit slow. Therefore I wanted to pause screen updating ( Application.ScreenUpdating = False ) while it runs but refrained. The reason is that the procedure just formats a single cell. You would probably call it from another procedure that loops through all your cells in a column, feeding each one to the above proc in turn. Use code like SetCharsBold Range("F1") . The screen control should be done in that procedure, delaying the update until its loop has run.

I forgot to remove Cell.Offset(18) from the code and decided to leave it there on second thought. I didn't want the code to over-write the original texts. Perhaps you have a similar need. Please adjust that line to suit.