Sam, Paul, snb

Thanks guys for all of your input and assistance. There is no perfect world but I think this will work for me:

Option Explicit
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
    If lngCount > 0 Then oCell.Value = AddTags(oCell)
    lngCount = lngCount + 1
    DoEvents
    Debug.Print lngCount
    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, bIsBoldItalic As Boolean
  bIsBold = False
  bIsItalic = False
  bIsBoldItalic = False
  Select Case oCell.Font.FontStyle
    Case Is = "Regular": strResult = oCell.Value
    Case Is = "Bold"
      strResult = "<B>" & oCell.Value & "</B>"
      oCell.Font.FontStyle = "Regular"
    Case Is = "Italic"
      strResult = "<i>" & oCell.Value & "</i>"
      oCell.Font.FontStyle = "Regular"
    Case Is = "Bold Italic"
      strResult = "<B><i>" & oCell.Value & "</i></B>"
      oCell.Font.FontStyle = "Regular"
    Case Else
      For lngIndex = 1 To Len(oCell.Value)
        If oCell.Characters(lngIndex, 1).Font.FontStyle = "Bold Italic" Then
          If bIsBoldItalic = False Then
            strResult = strResult + "<i><B>"
            bIsBoldItalic = True
          End If
        Else
          If bIsBoldItalic = True Then
            strResult = strResult + "</i></B>"
            bIsBoldItalic = False
          End If
        End If
        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
       
      Next lngIndex
      If bIsBold = True Then strResult = strResult + "</B>"
      If bIsItalic = True Then strResult = strResult + "</i>"
      If bIsBoldItalic = True Then strResult = strResult + "</i></B>"
  End Select
  If InStr(strResult, Chr(10)) > 0 Then
    strResult = Replace(strResult, Chr(10), "<P></P>")
  End If
  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