Sub InsertTextAroundTables_BATCHFINAL_working_no_issue()
    Dim folderPath As String
    Dim fileDialog As fileDialog
    Dim fileName As String
    Dim doc As Document
    Dim searchTextAbove As Variant
    Dim searchTextBelow As Variant
    Dim insertTextAbove As Variant
    Dim insertTextBelow As Variant
    Dim i As Integer
    
    ' Define search strings and corresponding texts to insert
    searchTextAbove = Array("BBEGINING", "EBEGINING", "IBEGINING")
    searchTextBelow = Array("BENDING", "EENDING", "IENDING")
    insertTextAbove = Array("123", "456", "789")
    insertTextBelow = Array("333", "666", "999")
    
    ' Prompt user to select a folder
    Set fileDialog = Application.fileDialog(msoFileDialogFolderPicker)
    With fileDialog
        .Title = "Select a Folder Containing Word Documents"
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        Else
            MsgBox "No folder selected. Exiting macro.", vbExclamation
            Exit Sub
        End If
    End With
    
    ' Loop through each Word document in the folder
    fileName = Dir(folderPath & "\*.docx")
    Do While fileName <> ""
        ' Open the document
        Set doc = Documents.Open(folderPath & "\" & fileName)
        
        ' Loop through each table in the document
        For Each tbl In doc.Tables
            ' Check if there's any running text before the table
            If tbl.range.start > doc.range.start Then
                ' Insert a line break before inserting text above the table
                doc.range(tbl.range.start - 1).InsertBefore vbCrLf
            End If
            
            ' Check if table contains any of the search strings
            For i = LBound(searchTextAbove) To UBound(searchTextAbove)
                If InStr(1, tbl.range.text, searchTextAbove(i)) > 0 Then
                    ' Insert text above the table
                    Set rng = tbl.range.Duplicate
                    rng.Collapse Direction:=wdCollapseStart
                    rng.MoveStart Unit:=wdCharacter, Count:=-1
                    rng.InsertBefore insertTextAbove(i) & vbCrLf
                    Exit For
                End If
            Next i
            
            For i = LBound(searchTextBelow) To UBound(searchTextBelow)
                If InStr(1, tbl.range.text, searchTextBelow(i)) > 0 Then
                    ' Insert text below the table
                    Set rng = tbl.range.Duplicate
                    rng.Collapse Direction:=wdCollapseEnd
                    rng.MoveEnd Unit:=wdCharacter, Count:=1
                    rng.InsertAfter vbCrLf & insertTextBelow(i)
                    Exit For
                End If
            Next i
        Next tbl
        
        ' Save and close the document
        doc.Save
        doc.Close
        
        ' Get the next file in the folder
        fileName = Dir
    Loop
    
    ' Inform user that the operation is complete
    MsgBox "Text has been inserted around tables in all documents in the selected folder.", vbInformation
End Sub

Sub TableTags()
  Dim str As String, aRng As Range, sPrefix() As String, i As Integer
  Dim insertTextAbove() As String, insertTextBelow() As String
  sPrefix = Split("B|E|I", "|")
  insertTextAbove = Split("123|456|789", "|")
  insertTextBelow = Split("333|666|999", "|")
  
  For i = LBound(sPrefix) To UBound(sPrefix)
    Set aRng = ActiveDocument.Range
    With aRng.Find
      .Forward = True
      .Text = sPrefix(i) & "BEGINING"
      If .Execute Then
        If aRng.Information(wdWithInTable) Then
          Set aRng = aRng.Tables(1).Range
          aRng.Collapse Direction:=wdCollapseStart
          aRng.MoveStart Unit:=wdCharacter, Count:=-1
          aRng.InsertBefore vbCrLf & insertTextAbove(i)
          GoTo NextOne
        End If
      End If
    End With
NextOne:
  Next i
  
  For i = LBound(sPrefix) To UBound(sPrefix)
    Set aRng = ActiveDocument.Range
    With aRng.Find
      .Forward = False
      .Text = sPrefix(i) & "ENDING"
      If .Execute Then
        If aRng.Information(wdWithInTable) Then
          Set aRng = aRng.Tables(1).Range
          aRng.Collapse Direction:=wdCollapseEnd
          'aRng.MoveEnd Unit:=wdCharacter, Count:=1
          aRng.InsertAfter insertTextBelow(i) & vbCrLf
          GoTo NextTwo
        End If
      End If
    End With
NextTwo:
  Next i
End Sub