Sub UpdateHeaderFooterWithShortDateAndPageNumbers()
    Dim tbl As table
    Dim cellContent As String

    ' Check if there is at least one table in the document
    If ActiveDocument.Tables.Count > 0 Then
        ' Get the first table
        Set tbl = ActiveDocument.Tables(1)

        ' Check if the table has at least one row and two columns
        If tbl.Rows.Count > 0 And tbl.Columns.Count >= 2 Then
            ' Get the content of cell(1, 2)
            cellContent = tbl.cell(2, 2).range.Text

            ' Remove any line breaks and extra spaces
            cellContent = Replace(cellContent, vbCr, "")
            cellContent = Trim(cellContent)

            ' Update the header and footer in all sections of the document
            For Each Section In ActiveDocument.Sections
                ' Set the header range
                Dim headerRange As range
                Set headerRange = Section.Headers(wdHeaderFooterPrimary).range

                ' Set the text content in the header
                headerRange.Text = cellContent

                ' Add a single black line under the text in the header
                headerRange.paragraphs.Last.range.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
                headerRange.paragraphs.Last.range.Borders(wdBorderBottom).Color = wdColorBlack

                ' Set the footer range
                Dim footerRange As range
                Set footerRange = Section.Footers(wdHeaderFooterPrimary).range

                ' Add an underline above the footer text
                'footerRange.paragraphs.Add
                footerRange.paragraphs.Last.range.Borders(wdBorderTop).LineStyle = wdLineStyleSingle

                ' Add the short date to the left side of the footer
                           
                'footerRange.paragraphs.Add
                footerRange.paragraphs.Last.range.Text = Format(Now, "Short Date") & "" & "  Page " & Section.range.Information(wdActiveEndPageNumber) & " of " & Section.range.Information(wdNumberOfPagesInDocument)
                footerRange.paragraphs.Last.range.ParagraphFormat.Alignment = wdAlignParagraphLeft
            Next Section
        End If
    End If
End Sub