Need Help in Date Format in Table - MS Word

[ragav_in]

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.



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

[gmaxey]

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

[ragav_in]

'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

[gmaxey]

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:


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