1. It takes time to read a property from an object so I used the booleans to hold the result if I needed it again (you did emphasize the need for speed), or just for readability (my style)
2. Something like .Font.FontStyle = "Bold" is MS Word oriented (I think) and involves two object levels and a string compare to return a T/F. Something like .Font.Bold returns T/F directly, so I thought it'd be a tad faster
3. There's been many discussions here in Excel-land about using arrays to improve speed since directly reading from the worksheet N times to manipulate data one cell at a time is a lot slower than bringing the N cells into an array all at once, crunch the array in memory, and then put all N cells back to the worksheet all at once. Of course, all that the array has are Values, no formatting. Join-ing the pieces into a single String for Replace is probably the equivalent
4. [OPINION]
Followup to snb's comment
a. You do not need to .Select something to use or act on it (MS Word is very 'Selection' object oriented)
b. I captured the returned Set of the .SpecialCells so that I could exit neatly if by chance there were no text cells
c. My style is to use enumerations instead of the numerical values for readability. The computer doesn't care, but I do when reading the code
d. If you were making this a general purpose sub, then you could just use
If Not TypeOf Selection Is Range Then Exit Sub
Set oRng = Nothing
On Error Resume Next
Set oRng = Selection.SpecialCells(xlCellTypeConstants, xlTextValues)
If oRng Is Nothing Then Exit Sub
5. You could make AddTags into a UserDefinedFunction and use it directly in cells on the worksheet, or call it inside a macro to do something with the tagged text
[/OPINION]
(Still in Hossler-style )
Option Explicit
Sub TagActiveCell()
MsgBox AddTags(ActiveCell)
End Sub
Function AddTags(oCell As Range) As String
Dim sResult As String, sChar As String
Dim i As Long, L As Long
Dim bBold As Boolean, bItal As Boolean
Dim A() As String
AddTags = vbNullString
With oCell
'check the entire cell
If Len(Trim(.Value)) = 0 Then Exit Function
If Not .Font.Bold And Not .Font.Italic Then
sResult = .Value
ElseIf .Font.Bold And .Font.Italic Then
sResult = "<b><i>" & .Value & "</i></b>"
ElseIf .Font.Bold And Not .Font.Italic Then
sResult = "<b>" & .Value & "</b>"
ElseIf Not .Font.Bold And .Font.Italic Then
sResult = "<i>" & .Value & "</i>"
Else
L = Len(.Value)
'number of chars
ReDim A(1 To L)
For i = 1 To L
sChar = .Characters(i, 1).Text
bBold = .Characters(i, 1).Font.Bold
bItal = .Characters(i, 1).Font.Italic
If bBold And bItal Then
A(i) = "<b><i>" & sChar & "</i></b>"
ElseIf bBold Then
A(i) = "<b>" & sChar & "</b>"
ElseIf bItal Then
A(i) = "<i>" & sChar & "</i>"
Else
A(i) = sChar
End If
Next i
sResult = Join(A, "")
'InStr faster than Replace if nothing to Replace
If InStr(sResult, "</b><b>") > 0 Then sResult = Replace(sResult, "</b><b>", vbNullString)
If InStr(sResult, "</i><i>") > 0 Then sResult = Replace(sResult, "</i><i>", vbNullString)
If InStr(sResult, "</i></b><b><i>") > 0 Then sResult = Replace(sResult, "</i></b><b><i>", vbNullString)
End If
End With
sResult = "<p>" & sResult & "</p>"
AddTags = Replace(sResult, Chr(10), "</p><p>")
End Function