Every time I write a RangeToHTML function, it’s different. I don’t re-use my old functions because the HTML elements that I care about change from project to project. I could make a generic RangeToHTML function that attempts to capture every possible cell property, but I don’t. I don’t want a bunch of code in my project that doesn’t do anything. I figure out which cell properties matter to the project and code those.

In this example, I not only did not want fidelity with the spreadsheet, I was using bold and italics to trigger completely different HTML elements. But usually I’m trying to make the cells look like they do in the spreadsheet for those characteristics that I’ve deemed important. Below is another example where I’m converting a range to HTML to put into an Outlook email. The things that are important to me are bold, italics, font size, cell alignment, merged cells, and bottom borders. That’s a lot of stuff, but it’s not every formatting element that could be applied to a cell.

Public Function RangeToHTML(ByRef rRng As Range) As String
   
    Dim rRow As Range, rCell As Range
    Dim sTable As String, sTd As String, sHead As String
    Dim aCells() As String, aRows() As String, aAttr() As String, aHead(1 To 2) As String
    Dim lCellCnt As Long, lRowCnt As Long
    Dim lFontSize As Long
   
    ‘1. Get the font size of the last cell
    lFontSize = rRng.Cells(rRng.Cells.Count).Font.Size
    ReDim aRows(1 To rRng.Rows.Count)
   
    ‘2 create the style in the header
    aHead(1) = "td {font-family:" & rRng.Cells(1).Font.Name & "; font-size: " & lFontSize & "pt}"
    aHead(2) = ".bb {border-bottom: 1px solid black}"
    sHead = Tag(Tag(Join(aHead, vbNewLine), "style", , True), "head", , True)
   
    ‘3. Load up a ‘cells’ array and a ‘rows’ array FOR joining.
    For Each rRow In rRng.Rows
        lRowCnt = lRowCnt + 1: lCellCnt = 0
        ReDim aCells(1 To rRng.Columns.Count)
        For Each rCell In rRow.Cells
            lCellCnt = lCellCnt + 1
           
            ‘4. Deal with empty cells and multi-line cells
            If IsEmpty(rCell.Value) Then
                sTd = " "
            Else
                sTd = Replace(rCell.Text, Chr$(10), "<br />")
            End If
           
            ‘5. Bold and italic
            If rCell.Font.Bold Then sTd = Tag(sTd, "strong")
            If rCell.Font.Italic Then sTd = Tag(sTd, "em")
           
            ‘6. Font size
            If rCell.Font.Size <> lFontSize Then
                sTd = Tag(sTd, "div", "style=font-size:" & rCell.Font.Size & "pt")
            End If
           
            ‘7. Setting the cell alignment
            ReDim aAttr(1 To 3)
            aAttr(1) = AlignmentAttr(rCell)
           
            ‘8. Span rows and columns for merged  cells
            If rCell.MergeArea.Address <> rCell.Address Then
                aAttr(2) = "COLSPAN=""" & rCell.MergeArea.Columns.Count & """ ROWSPAN=""" & rCell.MergeArea.Rows.Count & """"
            End If
           
            ‘9. Bottom border
            If rCell.Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone Then
                aAttr(3) = "class=""bb"""
            End If
           
            ’10. Make string
            If rCell.MergeArea.Cells(1).Address = rCell.Address Then
                aCells(lCellCnt) = Tag(sTd, "td", Join(aAttr, Space(1)))
            End If
        Next rCell
        aRows(lRowCnt) = Tag(Join(aCells, vbNewLine), "tr", , True)
    Next rRow
   
    sTable = Tag(Join(aRows, vbNewLine), "table", "cellpadding=""2px""", True)
   
    RangeToHTML = Tag(sHead & vbNewLine & sTable, "html", , True)
   
End Function

Here’s a breakdown of code:

  1. It’s a bit arbitrary, but I’m pulling the font size from the last cell in the range. For my data, I know that the header may have a different font size, but there is no footer. Whatever the last cell in the range is, that’s my default font size.
  2. I create two styles in the header: one for the default td element and one for the “bb” class (bottom border). The font name is pulled from the first cell of the range (because I know there’s o change in font family within the range. The font size I get from above. My Tag function is nested here so that my styles are in a ‘style’ tag and then the whole thing is wrapped in a ‘head’ tag.
  3. Inside the loop, I fill the aCells array with each cell. Before I go to the next row, I Join that array into an element of the aRows array. Later I’ll be Joining that array into a big string.
  4. If the cell is empty, I need a non-breaking space in my td tags. If the cell has more than one line, I insert the br HTML tag to replicate that.
  5. At this point, I’m just checking out the cell properties and converting them to HTML. These two lines wrap the value in ‘strong’ or ‘em’ if the cell is bold or italic, respectively.
  6. I got the default font size up in step 1. If this cells font size is different than the default, then I set it explicitly. I’d considered trying to make everything a relative font size, but ultimately it was a pain and unnecessary.
  7. There are three cell properties that will turn into attributes in the td tag. The first is the cell alignment. I have left, right, and center cells and set the align property using the AlignmentAttr function shown below.
  8. Next, I look for merged cells and set the COLSPAN and ROWSPAN attributes accordingly. Yes, I hate merged cells too, but sometimes they’re necessary.
  9. The I look for a bottom border, which I implement in a css class. I don’t look for every border because I only care about bottom borders.
  10. Finally, I make the string by Joining my Attr array. If I’m in the first cell of a merged area (which also is true if there is no merge area), then I make the string. If I’m not in the first cell, I don’t do anything because I’ve already done it back when I was in the first cell.

To wrap it all I up, I tag and join everything into one glorious string. The Tag function looks like this:

Function Tag(sValue As String, sTag As String, Optional sAttr As String = "", Optional bIndent As Boolean = False) As String
   
    Dim sReturn As String
   
    If Len(sAttr) > 0 Then
        sAttr = Space(1) & sAttr
    End If
   
    If bIndent Then
        sValue = vbTab & Replace(sValue, vbNewLine, vbNewLine & vbTab)
        sReturn = "<" & sTag & sAttr & ">" & vbNewLine & sValue & vbNewLine & "</" & sTag & ">"
    Else
        sReturn = "<" & sTag & sAttr & ">" & sValue & "</" & sTag & ">"
    End If
   
    Tag = sReturn
   
End Function

The AlignmentAttr function from #7 above. I put this in its own function to keep the close a little cleaner, not because it does anything special.

Public Function AlignmentAttr(ByRef rCell As Range) As String
   
    Dim sReturn As String
   
    Select Case True
        Case rCell.HorizontalAlignment = xlLeft, (rCell.HorizontalAlignment = 1 And Not IsNumeric(rCell.Value))
            sReturn = "align=""left"""
        Case rCell.HorizontalAlignment = xlRight, (rCell.HorizontalAlignment = 1 And IsNumeric(rCell.Value))
            sReturn = "align=""right"""
        Case rCell.HorizontalAlignment = xlCenter
            sReturn = "align=""center"""
    End Select
   
    AlignmentAttr = sReturn
   
End Function