How to clear a string according to a date
So, I created a workbook to check and publish sets of other books / reports elsewhere. Part of the process is for the user to enter a date value into a cell and this is checked inside the reports that the user has listed.
The formatting of the date doesn't matter because I am doing a date-to-date type comparison in my validation function.
Basically:
if CDate(UserVal) = CDate(ValFromString) then
'do stuff
end if
Another common occurrence is that the date was always at the end of a row in a matched cell.
Example:
Current 52 Weeks Ending 04/10/15
Cur 52 Weeks Apr 4, 2015
Current 52 WE 4-Apr-15
No matter what format the user enters into the validation cell, I just keep drawing on the right until isdate
it returns true.
I know I was lucky with this setup and the date was always at the end. Now I am facing two instances not working.
CURRENT 12 WEEKS (4 WEEKS ENDING 04/11/15)
4 WE 04/11/2015 Current 12
In the first case, the bracket breaks my right()
stripping. In the second, the date is in the middle. The format of the date value differs from report to report, so I cannot follow through instr(1, String, cstr(UserVal))
to perform validation. The location of the date is also not set in stone, as it can be at the end, at the beginning, or anywhere in the middle of the string.
A short way to put it, is there an easy way to scan a string for a specified date value, format agnostic?
source to share
Below you will find the date, if any, but it may not be the date you want:
Sub INeedADate()
Dim st As String, L As Long, i As Long, j As Long
st = ActiveCell.Text
L = Len(st)
For i = 1 To L - 1
For j = 1 To L
st2 = Mid(st, i, j)
If IsDate(st2) Then
MsgBox CDate(st2)
Exit Sub
End If
Next j
Next i
End Sub
This routine generates all correctly ordered substrings of the string and checks each one for IsDate ()
The problem is that for:
Current 52 weeks ends 04/10/15
It finds the substring:
04/1
valid date first!
Do you want ALL valid dates inside a string ???
EDIT # 1:
The solution is to just run the length portion of the Mid () function backwards:
Sub INeedADate()
Dim st As String, L As Long, i As Long, j As Long
st = ActiveCell.Text
L = Len(st)
For i = 1 To L - 1
For j = L To 1 Step -1
st2 = Mid(st, i, j)
If IsDate(st2) Then
MsgBox CDate(st2)
Exit Sub
End If
Next j
Next i
End Sub
source to share
Here is my weak attempt: D
This will fit a wide range of date formats
Hope it helps
Sub Sample()
Dim MyAr(1 To 5) As String, frmt As String
Dim FrmtAr, Ret
Dim i As Long, j As Long
MyAr(1) = "(This 01 has 04/10/15 in it)"
MyAr(2) = "This 04/10/2015"
MyAr(3) = "4-Apr-15 is a Sample date"
MyAr(4) = "(Apr 4, 2015) is another sample date"
MyAr(5) = "How about ((Feb 24 2012)) this?"
'~~> Various date formats
'~~> YYYY (/????) grouped together. Will search for this first
frmt = "??/??/????|?/??/????|??/?/????|??-??-????|"
frmt = frmt & "?-??-????|??-?-????|??? ?? ????|??? ? ????|"
frmt = frmt & "?-???-????|???-??-????|???-?-????|"
frmt = frmt & "??? ??, ????|??? ?, ????|"
'~~> YY (??) grouped after. Will search for this later
frmt = frmt & "??-???-??|?-???-??|??/??/??|?/??/??|??/?/??|"
frmt = frmt & "??-??-??|?-??-??|??-?-??|???-??-??|???-?-??|"
frmt = frmt & "|??? ?? ??|??? ? ??|??? ??, ??|??? ?, ??|"
FrmtAr = Split(frmt, "|")
For i = LBound(MyAr) To UBound(MyAr)
For j = 0 To UBound(FrmtAr)
'Something like =MID(A1,SEARCH("??/??/??",A1,1),8)
Expr = "=MID(" & Chr(34) & MyAr(i) & Chr(34) & ",SEARCH(" & _
Chr(34) & Trim(FrmtAr(j)) & Chr(34) & _
"," & Chr(34) & MyAr(i) & Chr(34) & ",1)," _
& Len(Trim(FrmtAr(j))) & ")"
Ret = Application.Evaluate(Expr)
If Not IsError(Ret) Then
If IsDate(Ret) Then
Debug.Print Ret
Exit For
End If
End If
Next j
Next i
End Sub
Output
EDIT
You can also use this as an Excel function
Insert this into a module
Public Function ExtractDate(rng As Range) As String
Dim frmt As String
Dim FrmtAr, Ret
Dim j As Long
ExtractDate = "No Date Found"
'~~> Various date formats
'~~> YYYY (/????) grouped together. Will search for this first
frmt = "??/??/????|?/??/????|??/?/????|??-??-????|"
frmt = frmt & "?-??-????|??-?-????|??? ?? ????|??? ? ????|"
frmt = frmt & "?-???-????|???-??-????|???-?-????|"
frmt = frmt & "??? ??, ????|??? ?, ????|"
'~~> YY (??) grouped after. Will search for this later
frmt = frmt & "??-???-??|?-???-??|??/??/??|?/??/??|??/?/??|"
frmt = frmt & "??-??-??|?-??-??|??-?-??|???-??-??|???-?-??|"
frmt = frmt & "|??? ?? ??|??? ? ??|??? ??, ??|??? ?, ??|"
FrmtAr = Split(frmt, "|")
For j = 0 To UBound(FrmtAr)
'Something like =MID(A1,SEARCH("??/??/??",A1,1),8)
Expr = "=MID(" & Chr(34) & rng.Value & Chr(34) & ",SEARCH(" & _
Chr(34) & Trim(FrmtAr(j)) & Chr(34) & _
"," & Chr(34) & rng.Value & Chr(34) & ",1)," _
& Len(Trim(FrmtAr(j))) & ")"
Ret = Application.Evaluate(Expr)
If Not IsError(Ret) Then
If IsDate(Ret) Then
ExtractDate = Ret
Exit For
End If
End If
Next j
End Function
Note . I am still working on a version RegEx
much shorter than this ...
Edit : as promised! I'm sure it made me more perfect, but now I can't spend more on it :)
RegEx version
Sub Sample()
Dim MyAr(1 To 5) As String
MyAr(1) = "(This 01 has (04/10/15) in it)"
MyAr(2) = "This 04/10/2015"
MyAr(3) = "4-Apr-15 is a smaple date"
MyAr(4) = "(Apr 4, 2015) is another sample date"
MyAr(5) = "How about ((Feb 24 2012)) this?"
For i = 1 To 5
Debug.Print DateExtract(MyAr(i))
Next i
End Sub
Function DateExtract(s As String) As String
Dim a As String, b As String, c As String
Dim sPattern As String
sPattern = "\b(jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec)"
sPattern = sPattern & "\s(\d\d?),?\s+(\d{2,4})|(\d\d?)[\s-]("
sPattern = sPattern & "jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec"
sPattern = sPattern & ")[\s-,]\s?(\d{2,4})|(\d\d?)[-/](\d\d?)[-/](\d{2,4})\b"
With CreateObject("VBScript.RegExp")
.Global = False
.IgnoreCase = True
.Pattern = sPattern
If .Test(s) Then
Dim matches
Set matches = .Execute(s)
With matches(0)
a = .SubMatches(0) & .SubMatches(3) & .SubMatches(6)
b = .SubMatches(1) & .SubMatches(4) & .SubMatches(7)
c = .SubMatches(2) & .SubMatches(5) & .SubMatches(8)
DateExtract = a & " " & b & " " & c
End With
End If
End With
End Function
source to share