hello all,

I've created a loop which is supposed to read through a series of cells and change all the html tags to be the actual font representation of them. So a bit of text with the html bold tags around such as <b>hello world </b> becomes hello world. However, the loops I've used to do this are incredibly slow. The code is below, can anyone suggest a better way of doing this please ?

Many thanks

Sub makehtml()
Dim tempword As String
Dim wordlen As Integer
  
    
    word = Excel.ActiveCell
    wordlen = Len(Excel.ActiveCell)
    Sheets("working").Cells(1, 1) = Excel.ActiveCell.Value
    myBold = False
    myItalic = False
    myUnderline = False
    For i = 1 To wordlen
        tempword = UCase(Mid(word, i, 3))
        If tempword = "<B>" Then
           myBold = True
        End If
        If tempword = "</B" Then
           myBold = False
        End If
        If tempword = "<U>" Then
           myUnderline = True
        End If
        If tempword = "</U" Then
           myUnderline = False
        End If
        If tempword = "<I>" Then
           myItalic = True
        End If
        If tempword = "</I" Then
           myItalic = False
        End If
        Sheets("working").Cells(1, 1).Characters(i, 1).Font.Bold = myBold
        Sheets("working").Cells(1, 1).Characters(i, 1).Font.Underline = myUnderline
        Sheets("working").Cells(1, 1).Characters(i, 1).Font.Italic = myItalic
    Next i

End Sub


Sub replacehtmlchars()
'
' replacehtmlchars Macro
'

'
    mycelladdress = ActiveCell.Address
    ActiveCell.Replace What:="<?>", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range(mycelladdress).Activate
    ActiveCell.Replace What:="</?>", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range(mycelladdress).Activate
        
End Sub

Sub applyhtml()
Dim tempword As String
Dim wordlen As Integer
  
    word = Sheets("working").Cells(1, 1)
    wordlen = Len(Sheets("working").Cells(1, 1))
    mainpos = 1
    myBold = False
    myItalic = False
    myUnderline = False
    For i = 1 To wordlen
        tempword = UCase(Mid(word, i, 3))
        If tempword = "<B>" Then
           i = i + 2
           myBold = True
        Else
           If tempword = "</B" Then
              i = i + 3
              myBold = False
           Else
              If tempword = "<U>" Then
                 i = i + 2
                 myUnderline = True
              Else
                 If tempword = "</U" Then
                    i = i + 3
                    myUnderline = False
                 Else
                    If tempword = "<I>" Then
                        i = i + 2
                        myItalic = True
                    Else
                      If tempword = "</I" Then
                        i = i + 3
                        myItalic = False
                      Else
                        mainpos = mainpos + 1
                      End If
                    End If
                 End If
               End If
             End If
           End If
       Excel.ActiveCell.Characters(mainpos, 1).Font.Bold = myBold
       Excel.ActiveCell.Characters(mainpos, 1).Font.Underline = myUnderline
       Excel.ActiveCell.Characters(mainpos, 1).Font.Italic = myItalic
    Next i

End Sub


Sub readableFormat()

 
  Application.ScreenUpdating = False
  Cells.Select
  Do While WorksheetFunction.CountIf(Cells, "*~<?>*") <> 0
     ThisCell = Cells.Find(What:="<?>", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
       xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
       ).Activate
     Call makehtml
     Call newreplacehtmlchars
     Call applyhtml
  Loop
Range("a1").Select

End Sub