title.vbs
' ==============================================================
' TableToMarkdown.bas
'
' Auto-detect tables by border style + header background color
' and convert them to Markdown format.
'
' [Table detection rules]
' Start row : leftmost cell has a top border AND dark background (header color)
' End row : a cell in the row has a bottom border AND next row has no borders
' Col group : starts at a left border, ends at a right border
' (equivalent to merged cells)
'
' [Assumptions]
' - Only one table per row
' - Header row has a darker theme color (TintAndShade < -0.1)
' - Data rows share the same theme color at full brightness (TintAndShade ~= 0)
' ==============================================================
Option Explicit
' ==============================================================
' [Public]: Main entry point
' Detects all tables on the active sheet and writes Markdown
' output to a sheet named "Markdown Output".
' ==============================================================
Public Sub ConvertAllTablesToMarkdown()
Dim ws As Worksheet
Set ws = ActiveSheet
' Prepare output sheet
Dim outSheet As Worksheet
On Error Resume Next
Set outSheet = ThisWorkbook.Sheets("Markdown Output")
On Error GoTo 0
If outSheet Is Nothing Then
Set outSheet = ThisWorkbook.Sheets.Add(After:=ws)
outSheet.Name = "Markdown Output"
Else
outSheet.Cells.Clear
End If
' Detect tables
Dim tableCount As Long
Dim tables() As TableInfo
tableCount = DetectTables(ws, tables)
If tableCount = 0 Then
MsgBox "No tables were found.", vbExclamation
Exit Sub
End If
' Convert each table to Markdown and write to output sheet
Dim outRow As Long
outRow = 1
Dim i As Long
For i = 0 To tableCount - 1
Dim md As String
md = TableToMarkdown(ws, tables(i))
' Write heading
outSheet.Cells(outRow, 1).Value = _
"## Table " & (i + 1) & _
" (Start row:" & tables(i).StartRow & _
" / End row:" & tables(i).EndRow & _
" / Cols:" & ColLetter(tables(i).StartCol) & "-" & ColLetter(tables(i).EndCol) & ")"
outRow = outRow + 1
' Write Markdown body line by line
Dim lines() As String
lines = Split(md, vbLf)
Dim j As Long
For j = 0 To UBound(lines)
If lines(j) <> "" Then
outSheet.Cells(outRow, 1).Value = lines(j)
outRow = outRow + 1
End If
Next j
outRow = outRow + 1 ' Blank row between tables
Next i
outSheet.Columns(1).AutoFit
outSheet.Activate
MsgBox tableCount & " table(s) converted to Markdown.", vbInformation
End Sub
' ==============================================================
' Struct: holds detected table boundary information
' ==============================================================
Private Type TableInfo
StartRow As Long ' First row of the table (header row)
EndRow As Long ' Last row of the table
StartCol As Long ' Leftmost column of the table
EndCol As Long ' Rightmost column of the table
End Type
' ==============================================================
' [Public]: Detect whether a row is a table start (header) row
'
' Returns True when the row satisfies all three conditions:
' 1) At least one cell has a left border (= start of a column group)
' 2) That cell also has a top border
' 3) That cell's background TintAndShade <= HEADER_TINT_THRESHOLD
' (i.e. the header's darker shade)
' ==============================================================
Public Function IsTableStartRow(ws As Worksheet, rowIndex As Long) As Boolean
Const HEADER_TINT_THRESHOLD As Double = -0.1
Dim maxCol As Long
maxCol = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1
Dim c As Long
For c = 1 To maxCol
Dim cell As Range
Set cell = ws.Cells(rowIndex, c)
' Left border present = start of a column group
If cell.Borders(xlEdgeLeft).LineStyle <> xlNone Then
' Check for top border
If cell.Borders(xlEdgeTop).LineStyle <> xlNone Then
' Check for header background color (darker tint)
If GetTintAndShade(cell) <= HEADER_TINT_THRESHOLD Then
IsTableStartRow = True
Exit Function
End If
End If
End If
Next c
IsTableStartRow = False
End Function
' ==============================================================
' [Public]: Detect whether a row is a table end (last data) row
'
' Returns True when all three conditions are met:
' 1) The row contains at least one bordered cell (= is inside a table)
' 2) At least one cell in the row has a bottom border
' 3) The next row has no bordered cells (= nothing follows)
' ==============================================================
Public Function IsTableEndRow(ws As Worksheet, rowIndex As Long) As Boolean
Dim maxRow As Long
maxRow = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
' Check that this row is inside a table
If Not RowHasBorderedCell(ws, rowIndex) Then
IsTableEndRow = False
Exit Function
End If
' Check for a bottom border on this row
If Not RowHasBottomBorder(ws, rowIndex) Then
IsTableEndRow = False
Exit Function
End If
' If this is the last used row, it is the end by definition
If rowIndex >= maxRow Then
IsTableEndRow = True
Exit Function
End If
' End row only if the next row has no borders
If RowHasBorderedCell(ws, rowIndex + 1) Then
IsTableEndRow = False
Else
IsTableEndRow = True
End If
End Function
' ==============================================================
' [Public]: Get the total row count of a table
'
' Treats startRow as the table header row and counts down to
' the end row (inclusive). The count includes the header row.
' Returns 0 if startRow is not a valid table start row.
'
' Parameters:
' ws - Target worksheet
' startRow - Row number where the table begins
' (must satisfy IsTableStartRow = True)
'
' Returns:
' Total row count (Long). Returns 0 if not a table start row.
'
' Example:
' Dim n As Long
' n = GetTableRowCount(ActiveSheet, 6) ' -> 13 (1 header + 12 data rows)
' ==============================================================
Public Function GetTableRowCount(ws As Worksheet, startRow As Long) As Long
' Return 0 if the given row is not a table start row
If Not IsTableStartRow(ws, startRow) Then
GetTableRowCount = 0
Exit Function
End If
Dim maxRow As Long
maxRow = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
Dim r As Long
For r = startRow To maxRow
If IsTableEndRow(ws, r) Then
GetTableRowCount = r - startRow + 1
Exit Function
End If
Next r
' If no end row is found, treat the start row as a single-row table
GetTableRowCount = 1
End Function
' ==============================================================
' Detect all tables on the sheet and populate a TableInfo array.
' Returns the number of tables found.
' ==============================================================
Private Function DetectTables(ws As Worksheet, ByRef tables() As TableInfo) As Long
Dim maxRow As Long
maxRow = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
ReDim tables(0)
Dim count As Long
count = 0
Dim r As Long
r = 1
Do While r <= maxRow
' Look for a table start row
If IsTableStartRow(ws, r) Then
Dim tInfo As TableInfo
tInfo.StartRow = r
' Scan downward for the matching end row
Dim endR As Long
endR = r
Do While endR <= maxRow
If IsTableEndRow(ws, endR) Then
tInfo.EndRow = endR
Exit Do
End If
endR = endR + 1
Loop
' Fall back: if no end row found, treat start row as end row
If tInfo.EndRow = 0 Then tInfo.EndRow = r
' Resolve column range from the header row's borders
Dim sc As Long, ec As Long
GetTableColRange ws, tInfo.StartRow, sc, ec
tInfo.StartCol = sc
tInfo.EndCol = ec
' Append to array
ReDim Preserve tables(count)
tables(count) = tInfo
count = count + 1
r = tInfo.EndRow + 1
Else
r = r + 1
End If
Loop
DetectTables = count
End Function
' ==============================================================
' Convert a single TableInfo region to a Markdown table string.
'
' Column group handling:
' A column group starts at a left border and ends at a right border,
' mirroring visually merged cells. The first non-empty cell value
' within the group is used as the representative value.
' ==============================================================
Private Function TableToMarkdown(ws As Worksheet, tbl As TableInfo) As String
' Resolve column groups from the header row
Dim groups() As ColGroup
Dim groupCount As Long
groupCount = GetColGroups(ws, tbl.StartRow, tbl.StartCol, tbl.EndCol, groups)
If groupCount = 0 Then
TableToMarkdown = ""
Exit Function
End If
' Header row
Dim md As String
md = BuildMarkdownRow(ws, tbl.StartRow, groups, groupCount)
' Separator row
md = md & BuildSeparatorRow(groupCount)
' Data rows
Dim r As Long
For r = tbl.StartRow + 1 To tbl.EndRow
md = md & BuildMarkdownRow(ws, r, groups, groupCount)
Next r
TableToMarkdown = md
End Function
' ==============================================================
' Struct: holds the start and end column of one column group
' ==============================================================
Private Type ColGroup
StartCol As Long ' First column of the group
EndCol As Long ' Last column of the group
End Type
' ==============================================================
' Build a ColGroup array by scanning left/right borders in the header row.
' Returns the number of groups found.
' ==============================================================
Private Function GetColGroups(ws As Worksheet, headerRow As Long, _
startCol As Long, endCol As Long, ByRef groups() As ColGroup) As Long
ReDim groups(0)
Dim count As Long
count = 0
Dim groupStart As Long
groupStart = 0
Dim c As Long
For c = startCol To endCol
Dim cell As Range
Set cell = ws.Cells(headerRow, c)
' Left border -> start of a new column group
If cell.Borders(xlEdgeLeft).LineStyle <> xlNone Then
groupStart = c
End If
' Right border -> end of the current column group
If cell.Borders(xlEdgeRight).LineStyle <> xlNone Then
If groupStart > 0 Then
ReDim Preserve groups(count)
groups(count).StartCol = groupStart
groups(count).EndCol = c
count = count + 1
groupStart = 0
End If
End If
Next c
GetColGroups = count
End Function
' ==============================================================
' Build one Markdown table row (| val | val | ... |).
' Uses the first non-empty cell value within each column group.
' Hyperlinks are converted to [text](url) format.
' ==============================================================
Private Function BuildMarkdownRow(ws As Worksheet, rowIndex As Long, _
groups() As ColGroup, groupCount As Long) As String
Dim cells() As String
ReDim cells(groupCount - 1)
Dim i As Long
For i = 0 To groupCount - 1
Dim val As String
val = ""
Dim c As Long
For c = groups(i).StartCol To groups(i).EndCol
Dim v As Variant
v = ws.Cells(rowIndex, c).Value
If v <> "" And Not IsEmpty(v) Then
' Convert hyperlinks to Markdown link syntax
val = GetCellMarkdownValue(ws.Cells(rowIndex, c))
Exit For
End If
Next c
cells(i) = val
Next i
BuildMarkdownRow = "| " & Join(cells, " | ") & " |" & vbLf
End Function
' ==============================================================
' Return the cell's display value as a Markdown string.
' If the cell contains hyperlinks, each is converted to [text](url).
' ==============================================================
Private Function GetCellMarkdownValue(cell As Range) As String
Dim rawVal As String
rawVal = CStr(cell.Value)
' Check for hyperlinks
If cell.Hyperlinks.Count > 0 Then
Dim result As String
result = rawVal
Dim hl As Hyperlink
For Each hl In cell.Hyperlinks
Dim linkText As String
Dim linkUrl As String
linkText = hl.TextToDisplay
linkUrl = hl.Address
' Append sub-address for in-sheet anchor links
If hl.SubAddress <> "" Then
linkUrl = linkUrl & "#" & hl.SubAddress
End If
result = Replace(result, linkText, "[" & linkText & "](" & linkUrl & ")")
Next hl
GetCellMarkdownValue = result
Else
GetCellMarkdownValue = rawVal
End If
End Function
' ==============================================================
' Build a Markdown separator row: | --- | --- | ... |
' ==============================================================
Private Function BuildSeparatorRow(groupCount As Long) As String
Dim seps() As String
ReDim seps(groupCount - 1)
Dim i As Long
For i = 0 To groupCount - 1
seps(i) = "---"
Next i
BuildSeparatorRow = "| " & Join(seps, " | ") & " |" & vbLf
End Function
' ==============================================================
' Determine the leftmost and rightmost columns of a table
' by scanning the header row for any border (left, right, or top).
' ==============================================================
Private Sub GetTableColRange(ws As Worksheet, headerRow As Long, _
ByRef startCol As Long, ByRef endCol As Long)
Dim maxCol As Long
maxCol = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1
startCol = 0
endCol = 0
Dim c As Long
For c = 1 To maxCol
Dim cell As Range
Set cell = ws.Cells(headerRow, c)
If cell.Borders(xlEdgeLeft).LineStyle <> xlNone Or _
cell.Borders(xlEdgeRight).LineStyle <> xlNone Or _
cell.Borders(xlEdgeTop).LineStyle <> xlNone Then
If startCol = 0 Then startCol = c
endCol = c
End If
Next c
End Sub
' ==============================================================
' Return True if the given row contains at least one bordered cell.
' ==============================================================
Private Function RowHasBorderedCell(ws As Worksheet, rowIndex As Long) As Boolean
Dim maxCol As Long
maxCol = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1
Dim c As Long
For c = 1 To maxCol
Dim cell As Range
Set cell = ws.Cells(rowIndex, c)
If cell.Borders(xlEdgeTop).LineStyle <> xlNone Or _
cell.Borders(xlEdgeBottom).LineStyle <> xlNone Or _
cell.Borders(xlEdgeLeft).LineStyle <> xlNone Or _
cell.Borders(xlEdgeRight).LineStyle <> xlNone Then
RowHasBorderedCell = True
Exit Function
End If
Next c
RowHasBorderedCell = False
End Function
' ==============================================================
' Return True if any cell in the given row has a bottom border.
' ==============================================================
Private Function RowHasBottomBorder(ws As Worksheet, rowIndex As Long) As Boolean
Dim maxCol As Long
maxCol = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1
Dim c As Long
For c = 1 To maxCol
If ws.Cells(rowIndex, c).Borders(xlEdgeBottom).LineStyle <> xlNone Then
RowHasBottomBorder = True
Exit Function
End If
Next c
RowHasBottomBorder = False
End Function
' ==============================================================
' Return the Interior.TintAndShade value of a cell.
' Returns 0 if the cell uses no theme color.
' ==============================================================
Private Function GetTintAndShade(cell As Range) As Double
On Error Resume Next
GetTintAndShade = cell.Interior.TintAndShade
On Error GoTo 0
End Function
' ==============================================================
' Convert a column number to its letter label (1->A, 27->AA, etc.)
' ==============================================================
Private Function ColLetter(colNum As Long) As String
Dim result As String
result = ""
Dim n As Long
n = colNum
Do While n > 0
Dim rem As Long
rem = (n - 1) Mod 26
result = Chr(65 + rem) & result
n = (n - 1) \ 26
Loop
ColLetter = result
End Function