VBA Word - Convert Pipe Tables To Word Tables Latest

Sub ConvertPipeTablesToWordTables()
    Dim doc As Document
    Set doc = ActiveDocument

    Dim rngFind As Range
    Set rngFind = doc.Content.Duplicate

    Dim tableDict As Scripting.Dictionary
    Set tableDict = New Scripting.Dictionary

    Dim rowCounter As Long
    rowCounter = 1

    With rngFind.Find
        .Text = "|--"
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = False
    End With

    Do While rngFind.Find.Execute
        Dim anchorPara As Paragraph
        Set anchorPara = rngFind.Paragraphs(1)

        Dim headerPara As Paragraph
        Set headerPara = anchorPara.Previous

        If Not headerPara Is Nothing Then
            If IsValidTableRow(headerPara.Range.Text) Then
                ' Clear existing dictionary for reuse
                tableDict.RemoveAll
                rowCounter = 1

                ' Store header row
                tableDict.Add rowCounter, headerPara.Range.Text
                rowCounter = rowCounter + 1

                ' Prepare range for deleting data lines (excluding anchorPara)
                Dim dataRange As Range
                Set dataRange = Nothing

                ' Collect data rows
                Dim nextPara As Paragraph
                Set nextPara = anchorPara.Next

                Do While Not nextPara Is Nothing
                    If IsValidTableRow(nextPara.Range.Text) Then
                        tableDict.Add rowCounter, nextPara.Range.Text
                        rowCounter = rowCounter + 1

                        If dataRange Is Nothing Then
                            Set dataRange = nextPara.Range.Duplicate
                        Else
                            dataRange.End = nextPara.Range.End
                        End If

                        Set nextPara = nextPara.Next
                    Else
                        Exit Do
                    End If
                Loop

                ' Insert table at header position
                InsertTableFromDictionary tableDict, headerPara.Range

                ' Delete only the data lines (not the anchor)
                If Not dataRange Is Nothing Then dataRange.Delete

                ' Now delete the anchor row separately
                anchorPara.Range.Delete
            End If
        End If

        rngFind.Start = anchorPara.Range.End + 1
        rngFind.End = doc.Content.End
    Loop

    Set tableDict = Nothing
End Sub

Function IsValidTableRow(lineText As String) As Boolean
    Dim trimmed As String
    trimmed = Trim(lineText)

    Dim pipeCount As Long
    pipeCount = UBound(Split(trimmed, "|")) - 1

    IsValidTableRow = (pipeCount >= 2 And InStr(trimmed, "|") > 0)
End Function

Sub InsertTableFromDictionary(dict As Scripting.Dictionary, insertRange As Range)
    If dict.Count = 0 Then Exit Sub

    Dim rowCount As Long: rowCount = dict.Count
    Dim colCount As Long: colCount = UBound(Split(dict.Item(1), "|")) - 1

    Dim tbl As Table
    Set tbl = insertRange.Tables.Add(Range:=insertRange, NumRows:=rowCount, NumColumns:=colCount)
    tbl.Borders.Enable = True

    Dim r As Long, c As Long, i As Long
    For r = 1 To rowCount
        Dim cells() As String
        cells = Split(dict.Item(r), "|")

        c = 1
        For i = 1 To UBound(cells) - 1
            tbl.Cell(r, c).Range.Text = Trim(cells(i))
            c = c + 1
        Next i
    Next r

    ' Bold the first row (header)
    tbl.Rows(1).Range.Bold = True
End Sub