How can I get MAX date from string with multiple date values and different characters?
Example of a string:
11AUG2016 Changed gggqqq2i8yj 29SEP2016 Removed tyijdg298 30SEP2016 Added ,mkdjenb200 03OCT2016 zzxxddd4423 04OCT2016 jioi==++-234jju 24OCT2016 Updated tuiomahdkj 10JAN2017 Updated zzzz T4123III 13JAN2017 Updated jukalzzz123 20JAN2017 iiiwwwaazz678uuh
Just for a twist, I'd prefer to use this regex:
((0[1-9]|1[0-9]|2[0-9]|3[0-1])(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)([0-9][0-9][0-9][1-9]))
Which will filter out strings like 00FOO or 99DEX and that sort of thing for the day and month. Also will reject if the year is 0000.
There are 3 capturing groups so the day, month and year can be pulled out with SubMatches(i).
The max date is found by using the WorksheetFunction.Max function on an array populated with the matches themselves - so no manipulation of worksheet data is done to get the answer:
Option Explicit
Sub Test()
MsgBox ExtractMaxDate(Sheet1.Range("A1"))
End Sub
Function ExtractMaxDate(str As String) As Date
Dim objRegex As Object 'RegExp
Dim objMatches As Object 'MatchCollection
Dim varDates() As Long
Dim i As Long
Dim strMaxDate As String
Set objRegex = CreateObject("VBScript.RegExp")
With objRegex
.Global = True
.IgnoreCase = True
' will not match days > 31 or strings that are not months or year 0000
.Pattern = "((0[1-9]|1[0-9]|2[0-9]|3[0-1])(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)([0-9][0-9][0-9][1-9]))"
End With
' run regex
Set objMatches = objRegex.Execute(str)
' any matches ?
If objMatches.Count > 0 Then
' re-dim the array to number of matches
ReDim varDates(0 To objMatches.Count - 1)
For i = 0 To objMatches.Count - 1
' get date as yyyy-mm-dd and use CDate and store in array of Long
varDates(i) = CDate(objMatches(i).SubMatches(3) & _
"-" & objMatches(i).SubMatches(2) & _
"-" & objMatches(i).SubMatches(1))
Next i
' get the max date out of the matches
strMaxDate = CDate(WorksheetFunction.Max(varDates))
Else
' no matches
strMaxDate = 0
End If
ExtractMaxDate = strMaxDate
End Function
Following my answer on your previous post here Link , find the code below:
Option Explicit
Sub ExtractDates()
Dim Reg1 As Object
Dim RegMatches As Variant
Dim Match As Variant
Dim i As Long
Dim dDay As Long
Dim dYear As Long
Dim dMon As String
Dim MaxDate As Date
Set Reg1 = CreateObject("VBScript.RegExp")
With Reg1
.Global = True
.IgnoreCase = True
.Pattern = "(\d{2}[a-zA-Z]{3}\d{4})" ' Match any set of 2 digits 3 alpha and 4 digits
End With
Set RegMatches = Reg1.Execute(Range("A1").Value)
i = 1
If RegMatches.Count >= 1 Then ' make sure there is at least 1 match
For Each Match In RegMatches
dDay = Left(Match, 2)
dYear = Mid(Match, 6, 4)
dMon = Mid(Match, 3, 3)
On Error Resume Next
If Not IsError(DateValue(dDay & "-" & dMon & "-" & dYear)) Then '<-- check if string has a valid date value
If Err.Number <> 0 Then
Else
Range("B" & i).Value = DateValue(dDay & "-" & dMon & "-" & dYear) ' <-- have the date (as date format) in column B
i = i + 1
End If
End If
On Error GoTo 0
Next Match
End If
MaxDate = WorksheetFunction.Max(Range("B1:B" & i - 1))
MsgBox "Maximum valid date value in string is " & MaxDate
End Sub
Screen-shot of your string, extracted date, and MsgBox displaying the maximum date:
with little modifications of my solution for your previous code:
Sub main()
Dim arr As Variant
With Range("A1")
arr = Split(.Value, " ")
With .Resize(UBound(arr) + 1)
.Value = Application.Transpose(arr)
.SpecialCells(xlCellTypeConstants, xlTextValues).Delete xlUp
.cells(1, 1) = WorksheetFunction.Max(.cells)
.Offset(1).Resize(.Rows.Count - 1).ClearContents
End With
End With
End Sub
@user3598756's answer gave me an idea that the string can be evaluated as an array (not tested):
MsgBox Evaluate("TEXT(MAX(IFERROR(--""" & Replace([A1], " ", """,),IFERROR(--""") & """,)),""ddmmmyyyy"")")
