Need Help in Date Format in Table - MS Word

All,

This is my first post, and before posting, I checked the forum, but was not able to find what I was looking for. I am new to VBA. I have a Table in MS Word Document which contains 4 Columns and n Rows (dynamic). The 4th Column is for Review Date and will have various Dates and Format as shown below.

S. No	Version	Description	Review Date
1	1.0	Description A	25/12/2019
2	1.1	Description B	9-JUN-2022
3	1.2	Description C	9-NOV-2022
4	2.0	Description D	6-JUL-2023
5	3.0	Description E	7-Jan-2023
6	3.8	Description F	7-Jul-2023

I have lots of word documents in a specific folder. The task in hand is to scan through each document, and find the table that contains the Review Date; normally identified by ActiveDocument.Tables(3). The code has to go through each value in that Column and check if the date value matches the format of "d-Mmm-YYYY".

Upon checking the table, if the code finds a date value in Column 4 which does not match the above format, it should count the number of instances that does not match and write the count to a new word document along with the document name. In the above scenario, it should return the count as 4 as only 7-Jan-2023 & 7-Jul-2023 match the date format of "d-Mmm-YYYY"; the other values are in different format "d-MMM-YYYY" and "dd/mm/yyyy".

The code that I have is as below, which provides a message box if the format matches. I need the below code to be tweaked to count the total number of format mismatch and provide the count as output of the macro. Your time and help is deeply appreciated.

Code:

---

Sub check_reviewDateFormat()
Dim aTable As Table, fdate, sdate, tdate, strCellText As String
Dim r As Long, c As Long
Set aTable = ActiveDocument.Tables(3)
With aTable
    For r = 2 To .Rows.Count
        For c = 4 To .Columns.Count
            If .Cell(r, 4).Range.Text <> "" Then
                fdate = .Cell(r, 4).Range.Text
            End If
   
            sdate = Trim(Left(fdate, Len(fdate) - 2))
            tdate = Format(sdate, "d-MMM-YYYY")
            MsgBox tdate
           
            If sdate = tdate Then
                MsgBox "Correct Format"
                Else: MsgBox "InCorrect Format"
            End If
           
        Next
    Next
End With
End Sub

---

Any help in this regard is deeply appreciated and thanks in advance for all those who put your time to go through this post.

Thanks
ragav_in

Code:

---

Sub check_reviewDateFormat()
Dim aTable As Table, fdate, sdate, tdate, strCellText As String
Dim lngRow As Long
Dim lngWrong As Long
Dim strPath As String
  Set aTable = ActiveDocument.Tables(3)
  With aTable
    For lngRow = 2 To .Rows.Count
      If .Cell(lngRow, 4).Range.Text <> "" Then
                fdate = .Cell(lngRow, 4).Range.Text
            End If
   
            sdate = Trim(Left(fdate, Len(fdate) - 2))
            tdate = Format(sdate, "d-MMM-YYYY")

           
            If sdate <> tdate Then
              lngWrong = lngWrong + 1
              strPath = ActiveDocument.FullName
            End If
           
        Next
    Next
End With
  ActiveDocument.Range.InsertAfter vbCr & strPath & " - " & lngWrong
End Sub

---

'Guru' Greg, many thanks for the support; this works. However, it also counts valid date format as "incorrect". The expected date format is "d-Mmm-YYYY". If the date format is "dd-MMM-YYYY" (see upper case MMM and 2 digits of dd), then this code considers it as incorrect. Is there a way where we can bypass this using Ucase or Lcase when formatting.

Additionally, I need one help. This code of yours writes the output in the same document as where it checks. I need to have this code in 1st word document and then run through a bunch of word documents in a folder and then capture this information for each document in a 2nd document. I am in the process of identifying on how to run this and other codes for a set of files in a folder, but for now, will it be possible for you to clarify me on how to get the output (ActiveDocument.Range.InsertAfter vbCr & strPath & " - " & lngWrong) not in the active document but on the document where the macro is documented. I would be thankful to you if you can help me on this, as I am in the process of getting some manual tasks automated that can save effort and increase accuracy.

Once again, a very big thanks for the support you have already provided for which I am indebted to you and this community. I would be more happy, if I am able to get solutions for additional queries I might have.

Thanks and regards,
ragav_in

ragav_in

I'm not going to give you the fish. Look at the following. In it, you will see how to create a new record document and write value to it. You will need to figure out your loop through files bit:

Code:

---

Sub check_reviewDateFormat()
Dim oTbl As Table, strCellText As String, strRef As String
Dim lngRow As Long
Dim lngWrong As Long
Dim strPath As String
Dim oDocRecord As Document
Dim oDoc As Document
  Set oDoc = ActiveDocument
  Set oDocRecord = Documents.Add
  Set oTbl = oDoc.Tables(3)
  With oTbl
    For lngRow = 2 To .Rows.Count
      If .Cell(lngRow, 4).Range.Text <> "" Then
        strCellText = Trim(fcnGetCellText(.Cell(lngRow, 4)))
      End If
      strRef = Format(strCellText, "d-MMM-YYYY")
      If Not StrComp(strCellText, strRef, 1) = 0 Then
        lngWrong = lngWrong + 1
        strPath = ActiveDocument.FullName
      End If
    Next
  End With
  oDocRecord.Range.InsertAfter strPath & " - " & lngWrong
  oDocRecord.Activate
lbl_Exit:
  Exit Sub
End Sub
Function fcnGetCellText(ByRef oCell As Word.Cell) As String
  'The range.text property includes the end of cell marker character which is a single character consisting of _
  ChrW(13) & ChrW(7). It has a length = 2
  fcnGetCellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
lbl_Exit:
  Exit Function
End Function

---