Convert Excel Table into HTML table with VBA code

Actually to convert Excel table into HTML table is to use Save As web page either whole sheet or selection but we also can use VBA code below to convert by selecting table range example below and run the code. New pop up window will open notepad with HTML code inside and immediately can paste into your blog or webpage.

Run below code to get HTML code inside notepad.

VBA Code:

Option Explicit
Sub ToCreateTableForSelectedRange()
    Dim OpnShell As Variant
    Dim FSO, fs As Object
    Dim StrPath As String
    
    Dim iRow As Integer, iCol As Integer
    Dim Cell As Range, Rng As Range
    Dim i As Integer, j As Integer, k As Integer
    Dim l As Integer, x As Integer
    
    Dim DbWitdh() As Double, DbWitdhTot As Double
    Dim DbWitdhP() As String, DbWitdhAcc As Double
    Dim iColSp As Byte
    
    Dim Qto As String, ClEnd As String
    Dim BdOpn As String, BdCls As String
    Dim TdOpn As String, TdCls As String
    Dim TrOpn As String, TrCls As String
    Dim TblOpn As String, TblCls As String
    Dim StrStyle As String, StrTblWd As String
    Dim StrCellSp As String, StrCellPd As String
    Dim StrBdrCol As String, StrBdr As String
    Dim TBdOpn As String, TBdCls As String
    Dim StrCS As String, StrWd As String, StrAl As String
    
    Qto = """": ClEnd = ">"
    BdOpn = "<b>": BdCls = "</b>"
    TdOpn = "<td": TdCls = "</td>"
    TrOpn = "<tr>": TrCls = "</tr>"
    StrStyle = " style=" & Qto & "border-collapse: collapse;"
    StrTblWd = " width: 500px;" & Qto
    StrCellSp = " cellspacing=" & Qto & "0" & Qto
    StrCellPd = " cellpadding=" & Qto & "3" & Qto
    StrBdrCol = " bordercolor=" & Qto & "#000000" & Qto
    StrBdr = " border=" & Qto & "1" & Qto
    TblOpn = "<table" & StrStyle & StrTblWd & StrCellSp & _
    StrCellPd & StrBdrCol & StrBdr & ClEnd
    TblCls = "</table>"
    TBdOpn = "<tbody>": TBdCls = "</tbody>"
    StrCS = " colspan=" & Qto: StrWd = " width=" & Qto
    StrAl = " align=" & Qto & "Center" & Qto
    
    Set Rng = Selection
    If Rng.Rows.Count < 2 Or Rng.Columns.Count < 2 Then
        MsgBox "Please select range with table!": GoTo Line1
    End If
    
    'To Create new Text File
    StrPath = VBA.Environ("UserProfile") & "\Desktop\TableGenerator.txt"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    'To Check files existance and delete
    On Error Resume Next
    If Dir(StrPath) <> "" Then Kill StrPath
    
    k = 1
    For Each Cell In Rng
        If Cell.Row > iRow And iRow > 0 Then Exit For
        If iRow = 0 Then iRow = Cell.Row
        If iCol = 0 Then iCol = Cell.Column
        ReDim Preserve DbWitdh(k): DbWitdh(k) = Cell.ColumnWidth
        DbWitdhTot = DbWitdhTot + DbWitdh(k)
        iColSp = k
        k = k + 1
    Next

    For x = LBound(DbWitdh) + 1 To UBound(DbWitdh)
        ReDim Preserve DbWitdhP(x)
        If x < UBound(DbWitdh) Then
            DbWitdhP(x) = Round((DbWitdh(x) / DbWitdhTot) * 100, 0)
            DbWitdhAcc = DbWitdhAcc + DbWitdhP(x)
        Else
            DbWitdhP(x) = 100 - DbWitdhAcc
        End If
    Next x
    
    k = 1
    If Dir(StrPath) = "" Then
        Set fs = FSO.CreateTextFile(StrPath, 2)
        With fs
            .WriteLine TblOpn & TBdOpn
            For i = iRow To iRow + Rng.Rows.Count - 1
                l = 1
                .WriteLine TrOpn
                For j = iCol To iCol + iColSp - 1
                    If k = 1 Then
                        .WriteLine TdOpn & StrCS & iColSp & Qto & _
                        StrWd & DbWitdhP(l) & "%" & Qto & StrAl & _
                        ClEnd & BdOpn & Cells(i, j) & BdCls & TdCls
                    Else
                        .WriteLine TdOpn & StrCS & iColSp & Qto & _
                        StrWd & DbWitdhP(l) & "%" & Qto & StrAl & _
                        ClEnd & Cells(i, j) & TdCls
                    End If
                    l = l + 1
                Next j
                .WriteLine TrCls
                k = k + 1
            Next i
            .WriteLine TBdCls & TblCls
        End With
    End If
    
    'Just To Open NotePad Created
    If Err = 0 Then
        OpnShell = Shell("C:\Windows\System32\notepad.exe " & _
        StrPath, vbNormalFocus)
    End If
    On Error GoTo 0
    
Line1:
    'Reset Variables
    iRow = 0: iCol = 0
    Set Cell = Nothing: Set Rng = Nothing
    Erase DbWitdh: DbWitdhTot = 0
    Erase DbWitdhP: DbWitdhAcc = 0
    iColSp = 0
End Sub

The result in HTML as below:

No.				Subject				Score				Grade
1				English				100
2				Mathematics				65
3				Science				30
4				Physics				55
5				History				20
6				Chemistry				48
7				Biology				70
8				Geography				90

Practice makes perfect. Thank You.

Debugging with Debug print method

Debug print is very useful for debugging instead of using message box because we can run without clicking OK button when we use message box. Debug print is utilizing immediate window below module under Visual Basic Editor (VBE) as below:

Base on above Table subject vs score we can print this value under immediate window as below:

The above example we use direct Debug.print value1,value2,value3,....

The purpose is to print value especially variables when our code is getting complicated and we wish to verify our code run without error later on.

Below example we use operator to connect or joint value1 & "-" & Value2 & "=" & Value3 but still using the same table above.

VBA Code:

Option Explicit
Sub PrintMethodExample()

    Dim i As Integer
    Dim StrSubject As String
    Dim IntScore As Integer
    With ActiveSheet
        i = 2
        Do
            'Assign Variables
            StrSubject = .Range("B" & i)
            IntScore = .Range("C" & i)
            
            'Print to immediate window for debugging
            Debug.Print i - 1 & "-" & StrSubject & "=" & IntScore
            
            'Reset Variables
            StrSubject = ""
            IntScore = 0
            i = i + 1
        Loop While .Range("A" & i) <> ""
    End With
    
End Sub

Result:

Note:
Normally when error occurred we put Debug.print before error line to verify which variables caused error. For example variable declare as integer but actual is long or double.

Microsoft Reference - Print Method

Practice makes perfect. Thank You.

Working with If...Then...Else

If...Then...Else statement is to test certain condition either true or false and can be tested as many level as per required. Basically can be divide into 4 types:

Below example base on Table subject vs score, decide what to do base on score.

1. Single condition with single line return (If...Then)
   
   
   

   No.			Condition			Return
   1			Score more than 50			Range background color to green

   VBA Code:

   Option Explicit
   Sub IFStatemantsSingleConditionSingleReturn()
   
       Dim i As Integer
       With ActiveSheet
           i = 2
           Do
               If .Range("C" & i) > 50 Then _
               Range("A" & i & ":C" & i).Interior.ColorIndex = 4
               i = i + 1
           Loop While .Range("A" & i) <> ""
       End With
       
   End Sub
   
   
2. Single condition with multiple line return (If...Then...End If)
   
   
   

   No.			Condition			Return
   1			Score more than 50			Range background color to green Font text bold

   VBA Code:

   Option Explicit
   Sub IFStatemantsSingleConditionMultipleReturn()
       
       Dim i As Integer
       With ActiveSheet
           i = 2
           Do
               If .Range("C" & i) > 50 Then
                   Range("A" & i & ":C" & i).Interior.ColorIndex = 4
                   Range("A" & i & ":C" & i).Font.Bold = True
               End If
               i = i + 1
           Loop While .Range("A" & i) <> ""
       End With
       
   End Sub
   
   
3. Double condition with multiple line return (If...Then...Else...End if)
   
   
   

   No.			Condition			Return
   1			Score more than 50			Range background color to green Font text bold
   2			Others			Range background color to Yellow

   VBA Code:

   Option Explicit
   Sub IFStatemantsDoubleConditionMultipleReturn()
       
       Dim i As Integer
       With ActiveSheet
           i = 2
           Do
               If .Range("C" & i) > 50 Then
                   Range("A" & i & ":C" & i).Interior.ColorIndex = 4
                   Range("A" & i & ":C" & i).Font.Bold = True
               Else
                   Range("A" & i & ":C" & i).Interior.ColorIndex = 6
               End If
               i = i + 1
           Loop While .Range("A" & i) <> ""
       End With
       
   End Sub
   
   
4. Multiple condition with multiple line return (If...Then...Elseif...Then...Else...End if)
   
   
   

   No.			Condition			Return
   1			Score more than 80			Range background color to green Font text bold
   2			Score more than 50			Range background color to Yellow
   3			Others			Range background color to Red

   VBA Code:

   Option Explicit
   Sub IFStatemantsMultipleConditionMultipleReturn()
       
       Dim i As Integer
       With ActiveSheet
           i = 2
           Do
               If .Range("C" & i) > 80 Then
                   Range("A" & i & ":C" & i).Interior.ColorIndex = 4
                   Range("A" & i & ":C" & i).Font.Bold = True
               ElseIf .Range("C" & i) > 50 Then
                   Range("A" & i & ":C" & i).Interior.ColorIndex = 6
               Else
                   Range("A" & i & ":C" & i).Interior.ColorIndex = 3
               End If
               i = i + 1
           Loop While .Range("A" & i) <> ""
       End With
       
   End Sub

Note:
Normally select case statement is more readable instead or using If...Then...Else statement with multiple condition and If...Then...Else statement can be place inside another if statement but be careful to close with End if properly.

Microsoft Reference - If..Then..Else statement

Practice makes perfect. Thank You.

Working with For...Next statements

For...Next statement is another type of loop but without check or condition to test. The loop is fix between numbers. Base on table below we are going to use For...Next statement to get total monthly sales.

VBA Code:

Option Explicit
Sub ForNextStatements()
    
    Dim i As Integer
    For i = 3 To 14
        Range("D" & i) = Range("B" & i) + Range("C" & i)
    Next i
    
End Sub

To do in reverse way:

Option Explicit
Sub ForNextStatementsRev()
    
    Dim i As Integer
    For i = 14 To 3 Step -1
        Range("D" & i) = Range("B" & i) + Range("C" & i)
    Next i
    
End Sub

Note:
After Next without mentioned i also work perfectly but prefer to add i after Next because whenever your code getting complicated then difficult to trace For..Next loop overlapping.

Microsoft Reference - For..Next statement

Practice makes perfect. Thank You.

Working with For Each...Next statements

For Each...Next statement is another type of loop but without check or condition to test. The loop is fix between certain range or numbers. Base on table below we are going to use For Each...Next statement to get total monthly sales.

Before proceed we must understand basic offset function.

The formula for offset = Range().Offset ([RowOffset], [ColumnOffset]) for example:
Range("A1") = Range("B1").offest(0,-1) which is refer to same cell or range.

VBA Code:

Option Explicit
Sub ForEachNextStatements()

    Dim RngS As Range
    Dim MyRng As Range
    
    Set MyRng = ActiveSheet.Range("D3:D14")
    For Each RngS In MyRng
        RngS = RngS.Offset(0, -2) + RngS.Offset(0, -1)
    Next
    
End Sub

Another Example to Loop every Sheets:

Option Explicit
Sub ForEachNextStatementsSht()
    
    Dim MySht As Worksheet

    For Each MySht In Worksheets
        'Your code goes here
        Debug.Print MySht.Name
    Next
    
End Sub

Another Example to Loop every Cells:

Option Explicit
Sub ForEachNextStatementsCell()
    
    Dim Cell As Range

    For Each Cell In ActiveSheet.UsedRange
        'Your code goes here
        Debug.Print Cell.Value
    Next
    
End Sub

Microsoft Reference - For Each..Next statement

Practice makes perfect. Thank You.