Convert Excel Cell Text in Bold or Italic to HTML Tags/Convert Cell Line Breaks
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:
Code:
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