CODEWITHSUNDEEP
excelvba
Miguel Zaldivar
Miguel Zaldivar

Reputation: 27

VBA - Parsing Date from Free Form Text String

I am attempting to parse out clean target DATES from cells populated with free form TEXT STRINGS.

ie: TEXT STRING: "ETA: 11/22 (Spring 4.5)" or "ETA 10/30/2019 EOD"

As you can see, there is no clear standard for the position of the date in the string, rendering LEFT or RIGHT formulas futile.

I tried leveraging a VBA function that I found which essentially breaks up the string into parts based on spaces in the string; however it has not been working.

Public Function GetDate(ResNotes As String) As Date

    Dim TarDate As Variant
    Dim part As Variant

    TarDate = Split(ResNotes, " ")

    For Each part In ResNotes
        If IsDate(part) = True Then
           GetDate = part
           Exit Function
        End If
    Next

    GetDate = "1/1/2001"
End Function

I'm referring to the cells with text strings as "ResNotes", short for "Resolution Notes" which is the title of the column

"TarDate" refers to the "Target Date" that I am trying to parse out

The result of the custom GETDATE function in Excel gives me a #NAME? error.

I expected the result to give me something along the lines of "10/30/2019"

Upvotes: 0

Views: 586

Answers (3)

T.M.
T.M.

Reputation: 9948

Approach isolating the date string via Filter function

Just for fun another approach demonstrating the use of the Filter function in combination with Split to isolate the date string and split it into date tokens in a second step; finally these tokens are transformed to date using DateSerial:

Function getDat(rng As Range, Optional ByVal tmp = " ") As Variant
  If rng.Cells.count > 1 Then Set rng = rng.Cells(1, 1)             ' allow only one cell ranges
  If Len(rng.value) = 0 Then getDat = vbNullString: Exit Function   ' escape empty cells
' [1] analyze cell value; omitted year tokens default to current year
'     (valid date strings must include at least one slash, "11/" would be interpreted as Nov 1st)
  tmp = Filter(Split(rng.Value2, " "), Match:="/", include:=True)   ' isolate Date string
  tmp = Split(Join(tmp, "") & "/" & Year(Now), "/")                 ' split Date tokens
' [2] return date
  Const M% = 0, D% = 1, Y& = 2                                      ' order of date tokens
  getDat = VBA.DateSerial(Val(tmp(Y)), Val(tmp(M)), _
                          IIf(tmp(D) = vbNullString, 1, Val(tmp(D))))
End Function

Upvotes: 0

Ron Rosenfeld
Ron Rosenfeld

Reputation: 60224

Unless you need VBA for some other part of your project, this can also be done using worksheet formulas:

=AGGREGATE(15,6,DATEVALUE(MID(SUBSTITUTE(A1," ",REPT(" ",99)),seq_99,99)),1)

where seq_99 is a named formula and refers to:

=IF(ROW($A$1:INDEX($A:$A,255,1))=1,1,(ROW($A$1:INDEX($A:$A,255,1))-1)*99)

*seq_99 generates an array of numbers {1;99;198;297;396;495;...

Format the cell with the formula as a Date of some type.

enter image description here

If there are no dates, it will return an error which you can either leave, or wrap the function in an IFERROR(your_formula,your_error_message)

Algorithm

  • Split the cell on the spaces
    • Replace each space with 99 spaces
    • Using the MID function, return an array of substrings 99 characters long
  • Apply the DATEVALUE function which will return either an error (if the substring is not a date) or a date serial number.
  • Since dates in Excel are serial numbers since 1/1/1900, we can use the AGGREGATE function to pick out a value, and ignore errors.

Upvotes: 2

Scott Craner
Scott Craner

Reputation: 152505

If you are getting #NAME then the code is not stored in a general module. It should NOT be in a worksheet module or ThisWorkbook module.

Also there are few errors in the code. Split returns a String Array. And since IsDate returns TRUE/FALSE the = True is not needed.

As per @MathieuGuindon we can change the string to a date in the code if found and return an error if not. For that we need to allow the return to be a variant.

Public Function GetDate(ResNotes As String)

    Dim TarDate() As String
    Dim part As Variant

    TarDate = Split(ResNotes, " ")

    For Each part In TarDate
        If IsDate(part) Then
           GetDate = CDate(part)
           Exit Function
        End If
    Next

    GetDate = "1/1/2001"
    'Instead of a hard coded date, one can return an error, just use the next line instead
    'GetDate =CVErr(xlErrValue)
End Function

Upvotes: 2

Related Questions