Convert Excel Cell Text in Bold or Italic to HTML Tags/Convert Cell Line Breaks

[gmaxey]

I have a very large Excel file where several of the columns contain multi-line descriptive data containing mixed formatted text (in addition to the normal font, some formatted with bold and some with italic). I need to replace the formatted "Bold" or "Italic" text in the cells with "<B>text</B> and "<I>text</I>" flags and add paragraph tags <P></P> to the cells replacing the Chr(10) linebreaks.

A real nub with Excel coding and all I could put together (from pecking through examples on the web) follows:

Problem: This is really slow as each character in each cell is evaluated. Is there anything equivalent in Excel to Words Find.Execute command such that I could simply set a range to each Cell then find "BOLD" text and insert the flags before and after each instance of a found instance?

Select the column to process:

Sub ConvertFormatToHTML()
Dim oRng As Range
Dim oCell
Dim lngCount As Long
Dim lngScope As Long
  Set oRng = Selection.Columns.Item(1)
  lngScope = GetLastRow(oRng)
  For Each oCell In oRng.Cells
    oCell.Value = AddTags(oCell)
    lngCount = lngCount + 1
    DoEvents
    If lngCount = lngScope Then Exit Sub
  Next
End Sub
Function AddTags(ByVal oCell As Range) As String
Dim lngIndex As Long
Dim strResult As String
Dim bIsBold As Boolean, bIsItalic As Boolean
  bIsBold = False
  bIsItalic = False
  For lngIndex = 1 To Len(oCell.Value)
    If oCell.Characters(lngIndex, 1).Font.FontStyle = "Bold" Then
      If bIsBold = False Then
        strResult = strResult + "<B>"
        bIsBold = True
      End If
    Else
      If bIsBold = True Then
        strResult = strResult + "</B>"
        bIsBold = False
      End If
    End If
    If oCell.Characters(lngIndex, 1).Font.FontStyle = "Italic" Then
      If bIsItalic = False Then
        strResult = strResult + "<I>"
        bIsItalic = True
      End If
    Else
      If bIsItalic = True Then
        strResult = strResult + "</I>"
        bIsItalic = False
      End If
    End If
    strResult = strResult + oCell.Characters(lngIndex, 1).Text
    If oCell.Characters(lngIndex, 1).Text = Chr(10) Then
      strResult = strResult & "</P><P>"
    End If
  Next lngIndex
  If bIsBold = True Then strResult = strResult + "</B>"
  If bIsItalic = True Then strResult = strResult + "</I>"
  If Len(strResult) > 0 Then
    AddTags = "<P>" & strResult & "</P"
  Else
    AddTags = vbNullString
  End If
  AddTags = Replace(AddTags, "<P><P>", "<P>")
  AddTags = Replace(AddTags, "</P></P>", "</P>")
  AddTags = Replace(AddTags, Chr(10), "")
lbl_Exit:
  Exit Function
End Function
Function GetLastRow(oRng As Range) As Long
  GetLastRow = Cells(Rows.Count, oRng.Column).End(xlUp).Row
lbl_Exit:
  Exit Function
End Function