Detect bold texts in a cell and add ";" before those texts

I have 3 columns that have the same pattern. Here is the example:

" I Love Chocolate
I really love chocolate
I want to drink hot chocolate
I have a red bike
I buy it with my own money
I hate mouse
I hate mouse since I was little "

I want to add semicolon before each of the line of bold texts in the cell. Like this:

" ;I Love Chocolate
I really love chocolate
I want to drink hot chocolate
;I have a red bike
I buy it with my own money
;I hate mouse
I hate mouse since I was little "

I used a Macro like this, but it doesn't work. It gave no error warning; it just doesn't work as I wanted it to be.

Sub AddSemicolonBeforeBoldText()
    Dim rng As Range
    Dim cell As Range
    Dim text As String
    Dim startPos As Integer
    Dim endPos As Integer
    
    Set rng = ActiveSheet.UsedRange
    
    For Each cell In rng
        If cell.HasFormula Then
            ' Skip cells with formulas
            GoTo ContinueLoop
        End If
        
        text = cell.Value
        startPos = 1
        
        Do While startPos <= Len(text)
            startPos = InStr(startPos, text, "*", vbTextCompare)
            If startPos = 0 Then Exit Do
            
            endPos = InStr(startPos + 1, text, "*", vbTextCompare)
            If endPos = 0 Then Exit Do
            
            ' Insert a semicolon before the bold text
            text = Left(text, startPos - 1) & ";" & Mid(text, startPos)
            startPos = endPos + 1 ' Move the start position after the second asterisk
        Loop
        
        cell.Value = text
        
        ContinueLoop:
    Next cell
End Sub

What did I do wrong?

Try this, it steps backwards through each character in the cell, if the character is not bold and the character following it is bold then it adds a semicolon (the semicolon itself being bold)

Sub AddSemicolonBeforeBoldText()
    Dim rng As Range
    Dim cell As Range
    
    Set rng = ActiveSheet.UsedRange
    
    For Each cell In rng
        If cell.HasFormula Then
            ' Skip cells with formulas
            GoTo ContinueLoop
        End If
        
        Dim i As Long
        For i = cell.Characters.Count - 2 To 0 Step -1
            If i = 0 Or Not cell.Characters(i, 1).Font.Bold Then
                If cell.Characters(i + 1, 1).Font.Bold Then
                    cell.Characters(i + 1, 0).Insert ";"
                End If
            End If
        Next i
        
ContinueLoop:
    Next cell
End Sub

... if you want, you can also tidy the code up further by eliminating the GoTo as follows

Sub AddSemicolonBeforeBoldText()
    Dim rng As Range
    Dim cell As Range
    
    Set rng = ActiveSheet.UsedRange
    
    For Each cell In rng
        If Not cell.HasFormula Then
            Dim i As Long
            For i = cell.Characters.Count - 2 To 0 Step -1
                If i = 0 Or Not cell.Characters(i, 1).Font.Bold Then
                    If cell.Characters(i + 1, 1).Font.Bold Then
                        cell.Characters(i + 1, 0).Insert ";"
                    End If
                End If
            Next i
        End If
    Next cell
End Sub

Answer updated with images

The code will change this ...

... to this ...