Paul,

Good points. I've revised as follows:

Sub ConvertFormatToHTML()
Dim oRng As Range
Dim oCell As Range
  ActiveSheet.Columns(1).Select
  Set oRng = Nothing
  On Error Resume Next
  Set oRng = Selection.Columns(1).SpecialCells(xlCellTypeConstants, xlTextValues)
  On Error GoTo 0
  If oRng Is Nothing Then Exit Sub
  For Each oCell In oRng.Cells
    oCell.Offset(0, 1).Value = AddTags(oCell)
    'oCell.Value = AddTags(oCell)
  Next
lbl_Exit:
  Exit Sub
End Sub
Function AddTags(oCell As Range) As String
Dim strResult As String, strChar As String
Dim lngIndex As Long, lngLen As Long
Dim arrChrs() As String
Dim bBold As Boolean, bItalic As Boolean
  With oCell
    'Check the entire cell
    If Not .Font.Bold = True And Not .Font.Italic = True Then
      strResult = .Value
    ElseIf .Font.Bold = True And .Font.Italic = True Then
      strResult = "<b><i>" & .Value & "</i></b>"
    ElseIf .Font.FontStyle = "Bold" Then
      strResult = "<b>" & .Value & "</b>"
    ElseIf .Font.FontStyle = "Italic" Then
      strResult = "<i>" & .Value & "</i>"
    Else
      lngLen = Len(.Value)
      'Number of chars
      ReDim arrChrs(1 To lngLen)
      For lngIndex = 1 To lngLen
        strChar = .Characters(lngIndex, 1).Text
        bBold = .Characters(lngIndex, 1).Font.Bold
        bItalic = .Characters(lngIndex, 1).Font.Italic
        Select Case True
          Case bBold And bItalic: arrChrs(lngIndex) = "<b><i>" & strChar & "</i></b>"
          Case bBold: arrChrs(lngIndex) = "<b>" & strChar & "</b>"
          Case bItalic: arrChrs(lngIndex) = "<i>" & strChar & "</i>"
          Case Else: arrChrs(lngIndex) = strChar
        End Select
      Next lngIndex
      strResult = Join(arrChrs, "")
    End If
    'InStr faster than Replace if nothing to Replace
    If InStr(strResult, "</b><b>") > 0 Then strResult = Replace(strResult, "</b><b>", vbNullString)
    If InStr(strResult, "</i><i>") > 0 Then strResult = Replace(strResult, "</i><i>", vbNullString)
    If InStr(strResult, "</i></b><b><i>") > 0 Then strResult = Replace(strResult, "</i></b><b><i>", vbNullString)
  End With
  strResult = "<p>" & strResult & "</p>"
  AddTags = Replace(strResult, Chr(10), "</p><p>")
lbl_Exit:
  Exit Function
End Function