Excel, RegEx and Dates

[Atroxell]

Okay, I am trying to use RegEx for the firs time and I am missing something.

I have files sent to me to include in our Act-On/Salesforce system. Part of the processing is to standardize the data. I have the dates sent to me in the following sample formats. Since I don't want to have to write huge blocks of rules to try to extract the dates rom the values, I thought I would give RegEx a try. The first three columns (A, C, and E) are standard date formats for Excel and I can use isDate() to test those. But the other three are being tricky.

Excel 2007

	A	B	C	D	E	F	G	H	I	J	K
1	Time Stamp		Download Date		Date		Registration Date		Date/Timestamp of Activity		When
2	9/1/2014		2-Sep-14		8/29/14 1:22 PM		08/15/2014 12:08:29 PM PDT		31 Aug 2014 02:00PM		Thursday, Sep 04 2014, 08:02 AM MDT
3	9/2/2014		1-Sep-14		8/29/14 2:30 PM		08/28/2014 07:36:38 PM PDT		20 Aug 2014 03:24PM		Thursday, Aug 28 2014, 01:52 PM MDT
4	9/2/2014		1-Sep-14		8/29/14 5:14 PM		08/22/2014 05:56:08 AM PDT		25 Aug 2014 01:30PM		Thursday, Aug 28 2014, 02:52 PM MDT
5	9/2/2014		31-Aug-14		8/30/14 3:15 AM		08/24/2014 09:43:06 AM PDT		19 Aug 2014 10:37PM		Thursday, Aug 28 2014, 02:41 PM MDT
6	9/2/2014		30-Aug-14		8/30/14 1:51 PM		08/22/2014 07:14:09 AM PDT		19 Aug 2014 08:52PM		Tuesday, Sep 02 2014, 02:58 PM MDT
7	9/2/2014		30-Aug-14		8/30/14 7:16 PM		08/22/2014 05:55:31 AM PDT		20 Aug 2014 09:27AM		Saturday, Aug 30 2014, 03:34 PM MDT
8	9/2/2014		30-Aug-14		8/31/14 8:57 AM		08/16/2014 02:27:11 PM PDT		4 Sep 2014 04:01PM		Sunday, Aug 31 2014, 01:34 AM MDT
9	9/2/2014		29-Aug-14		8/31/14 1:45 PM		08/22/2014 05:51:59 PM PDT		27 Aug 2014 05:04PM		Thursday, Aug 28 2014, 02:07 PM MDT
10	9/2/2014		2-Sep-14		8/31/14 10:55 PM		08/26/2014 12:04:44 PM PDT		24 Aug 2014 08:05AM		Thursday, Aug 28 2014, 07:47 PM MDT
11	9/2/2014		1-Sep-14		9/1/14 8:34 AM		08/19/2014 11:44:35 AM PDT		28 Aug 2014 07:17AM		Friday, Aug 29 2014, 11:18 AM MDT
12	9/2/2014		1-Sep-14		9/1/14 11:02 AM		08/22/2014 07:50:39 AM PDT		4 Sep 2014 04:01PM		Tuesday, Sep 02 2014, 07:10 AM MDT
13	9/2/2014		2-Sep-14		9/1/14 12:17 PM		08/27/2014 01:07:43 PM PDT		31 Aug 2014 04:50PM		Tuesday, Sep 02 2014, 08:43 AM MDT

<tbody>
</tbody>

I have tried the following code to attempt to coax out the patterns, but I am afraid my RegEx knowledge is too limited. The code works with standard dates in columns A & C. But I cannot get the other columns to work. Apparently I am missing something...

Sub newStyle()


      regExPattern(0) = "(0[1-9]|1[012])[- /.](0[1-9]|[12][0-9]|3[01])[- /.](20\d\d)"     ' Seems to be VALID
      regExPattern(1) = "([1-9]|[12][0-9]|3[01])[- /.]([1-9]|1[012])[- /.](20\d\d)"          ' Seems to be VALID
      regExPattern(2) = "([1-9]|[12][0-9]|3[01])[-](Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[-](20\d\d)(\s)(0-9)(0-9)(\:)(0-9)(0-9)(AM|PM)(.)"
      regExPattern(3) = "(Monday|Tuesday|Wednesday|Thursday|Friday|Saturday|Sunday)(\,)(\s)(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)(\s)" _
                                         & "(0[1-9]|[12][0-9]|3[01])(\s)(20\d\d)(\,)(\s)(0-9)(0-9)(.)(0-9)(0-9)(AM|PM)(.)(AM|PM)(\s)([A-Z][A-Z]\T)"
      regExPattern(4) = "(0[1-9]|1[012])[- /.](0[1-9]|[12][0-9]|3[01])[- /.](20\d\d)(\s)(0-9)(0-9)(.)(0-9)(0-9)(AM|PM)(.)([A-Z][A-Z]\T)"
      regExPattern(5) = "'     (20\d\d)[- /.](0[1-9]|1[012])[- /.](20\d\d)"


      For x = 0 To 5
            'chkVal = RegExDate("2-Sep-14", regExPattern(x))
            If RegExDate("2-Sep-14", regExPattern(x)) <> "" Then
                  MsgBox "worked at #" & x
                  Exit For
            End If
      
      Next x
End Sub

Private Function RegExDate(s As String, strPattern As String) As String
    Dim re, match
    Set re = CreateObject("vbscript.regexp")
    re.Pattern = strPattern
    ' re.Pattern = "(0[1-9]|1[012])[- /.](0[1-9]|[12][0-9]|3[01])[- /.](20\d\d)"
    re.Global = True


    For Each match In re.Execute(s)
        MsgBox match.Value
        RegExDate = match.Value
        Debug.Print RegExDate
        Exit For
    Next
    Set re = Nothing
End Function

Can someone give me a few pointers to set me on the correct course?

Thanks in Advance.

 

[Docmarti]

Maybe this one could work with your date system.

Function ExtrDate(s As String)
  Dim ss As String
  Dim i As Long
   
  ss = s
 
 
  ExtrDate = "No date found"


  For j = Len(s) To 1 Step -1
        ss = Mid(ss, 1, j)
        If IsDate(ss) Then Exit For
  Next


  If CDbl(DateValue(ss)) <> 0 Then
      ExtrDate = CDate(DateValue(ss) & " " & TimeValue(ss))
  Else
      ExtrDate = CDate(TimeValue(ss))
  End If


End Function

 

[Rick Rothstein]

Here is another function (can be used as a UDF if desired) that appears to work with the dates shown in Message #1...

Function GetDate(ByVal S As String)
  GetDate = "No Date Found"
  If S Like "* [A-Z]DT" Then S = Left(S, Len(S) - 4)
  If InStr(S, ", ") Then S = Mid(S, InStr(S, " ") + 1)
  S = Application.Trim(Replace(Replace(Replace(S, ",", ""), "PM", " PM", , , vbTextCompare), "AM", " AM", , , vbTextCompare))
  If IsDate(S) Then GetDate = CDate(S)
End Function

 

[Peter_SSs]

For me (in another date system) Peter’s UDF works correctly (for column G) if:

s = Replace(Replace(s, "am", ",", 1, -1, 1), "pm", ",", 1, -1, 1)

István

I am also in another date system and you are right that the added parameters do make a difference so to tidy up my function would become

Function ExtrDate(S As String)
  Dim bits
  Dim i As Long
  
  ExtrDate = "No date found"
  S = Replace(Replace(S, "am", ",", 1, -1, 1), "pm", ",", 1, -1, 1)
  bits = Split(S, ",")
  For i = 0 To UBound(bits)
    If IsDate(bits(i)) Then
      ExtrDate = Int(CDate(bits(i)))
      Exit Function
    End If
  Next i
End Function

 

[Atroxell]

Wow! When it rains, it pours!

Thanks to all of you for your responses. I'll be digging through these to see them all work (because I'm a little nerdy like that) and look forward to posting a response as to which I will be using.

Thanks again to everyone!

 

[Atroxell]

In case anyone is interested, I have a working solution. I may have boogered up the solutions I was given just a bit to fit my issue, but it works for all formats that I presented.

There are several procedure calls that I use to interact with the user, and I won't bother you by explaining them. The rest is a breakdown and correction of the ****-eyed formats I am occasionally passed.

The important part is that I save a TON of time using this procedure.

Sub correctDates(control As IRibbonControl)
      SCol = ""
      setActive
      wbSource.Activate
      
      getCol "When"
      colID = SCol
      chkVal = Range(colID & "2").Value
      testVal = IsNumeric(Range(colID & "2"))
      
      lastRow = Range("A" & rowTest).End(xlUp).Row
      
      If testVal = False Then
      
            Range(colID & "2:" & colID & lastRow).Replace What:=" MST", Replacement:="", LookAt:=xlPart, _
                  SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
                  ReplaceFormat:=False
                  
            Range(colID & "2:" & colID & lastRow).Replace What:=" PST", Replacement:="", LookAt:=xlPart, _
                  SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
                  ReplaceFormat:=False
      
            Range(colID & "2:" & colID & lastRow).Replace What:=" MDT", Replacement:="", LookAt:=xlPart, _
                  SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
                  ReplaceFormat:=False
                  
            Range(colID & "2:" & colID & lastRow).Replace What:=" PDT", Replacement:="", LookAt:=xlPart, _
                  SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
                  ReplaceFormat:=False
                  
            Range(colID & "2:" & colID & lastRow).Replace What:="AM", Replacement:="", LookAt:=xlPart, _
                  SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
                  ReplaceFormat:=False
                  
            Range(colID & "2:" & colID & lastRow).Replace What:="PM", Replacement:="", LookAt:=xlPart, _
                  SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
                  ReplaceFormat:=False
      End If
      
      For Each c In Range(colID & "2:" & colID & lastRow)
            If testVal = True Then
                  c.Value = CInt(c)
                  c.NumberFormat = "m/d/yyy"
            Else
                  c.Value = Trim(ExtrDate(c.Value))
            End If
      Next c
      
      Range(colID & "2:" & colID & lastRow).NumberFormat = "m/d/yyyy"
      
      SCol = ""
      enable_Defaults
      returnHome
End Sub

HUGE thanks to everyone for the suggestions, solutions and insights that led me to this solution!