?
Solved

Search non-standard string for date/time values

Posted on 2013-10-22
12
Medium Priority
?
139 Views
Last Modified: 2014-10-21
Does anyone have a decent vba function that I can use to find and extract date/time combinations from nonstandard strings? I can write one, but I'm hoping someone already has something.

Formats I'm seeing are
1/5 1525
1525 1/5/2012
1525 01/05/2012
01/05/2012 1525

etc
0
Comment
Question by:pflugg
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
  • 2
  • +2
12 Comments
 
LVL 49

Expert Comment

by:Martin Liss
ID: 39592831
From those dates I can't tell if they are dmy or mdy, and if they could be either then you will have an impossible task.
0
 
LVL 26

Expert Comment

by:jerryb30
ID: 39592913
Are they the total strings, or inside another string?

What is the desired output?
0
 
LVL 26

Expert Comment

by:jerryb30
ID: 39592925
Also, you use 'etc.'  Are there more possible inputs?
This appears to be a very specific situation, so the solution would be custom.
Basic logic-Split string using space as delimiter
If element1 isDate, get element2, format as time (adding : at right place) and cdate(element1  & " " & formattedElement2)
else
format element1 as time, and cdate(element2 & " " & formattedElement1).
0
Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 39592991
I'm with MartinLiss for the most part,


But lets presume for a moment that you are using the US date format (m/d/y):

1. Note that 1/5 is not a valid date.  It basically means January 5th, ...but without a year, it is not a "valid" date.

2. Look at the 1525, :
is this 15 minutes, 25 seconds, ...or is it 1525 Hr Military time (3:25 PM)
...and how would a program know?

About the best you can do is set some hard rules, then accept the fact that some dates (that do not fit your rules) may be converted incorrectly, or not converted at all...


So what exact date/time do you see when you look at at of those strings?

JeffCoachman
0
 

Author Comment

by:pflugg
ID: 39593914
I've requested that this question be deleted for the following reason:

Comments obvious and of no value.
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 39593915
<Comments obvious and of no value. >
Then why not reply to us directly instead of closing the question?

You never replied to any of our posts...?

I asked:
"So what exact date/time do you see when you look at at of those strings?"
If you answered this question, any of us can provide a useful solution.

JeffCoachman
0
 
LVL 30

Expert Comment

by:hnasr
ID: 39593957
You asked a question, and you deserve an answer. So don't be put off by any comment.
Here is a way, and if you like this comment, then cancel the request to delete.

You may need a way to organize such inputs in a table, then use queries to manipulate that table.

Assume original table x1(a1, a2)

a1      a2
1      1/5 1232
2      1/6/2013 1233
3      1234 1/7/2013

Code to create table x1t(dt, tm) and fill records from original table. You may modify x1t to include more fields, or you can update existing fields in another table.

code in button named cmdCheck_
Private Sub cmdCheck_Click()
    Dim rs3 As Recordset
    Dim rs3a() As String
    Set rs3 = CurrentDb.OpenRecordset("select a2 from x1")
    rs3.MoveFirst
    Dim i As Integer
    DoCmd.SetWarnings False
    DoCmd.RunSQL "Select #2013/01/01# as dt, #01:01# as tm into x1t From x1 where false"
    Do While Not rs3.EOF
        rs3a = Split(rs3(0), " ")
        
        If InStr(1, rs3a(0), "/") > InStr(1, rs3a(1), "/") Then
            '1st part is date
            '2nd part is time
            rs3a(0) = Format(rs3a(0), "yyyy/mm/dd")
            rs3a(1) = Format(Left(rs3a(1), 2) & ":" & Right(rs3a(1), 2), "hh:mm")
            
            DoCmd.RunSQL "Insert into x1t(dt, tm) values (#" & rs3a(0) & "#,#" & rs3a(1) & "#)"

        Else
            '1st part is time
            '2nd part is date
            rs3a(1) = Format(rs3a(1), "yyyy/mm/dd")
            rs3a(0) = Left(rs3a(0), 2) & ":" & Right(rs3a(0), 2)
            DoCmd.RunSQL "Insert into x1t(tm, dt) values (#" & rs3a(0) & "#,#" & rs3a(1) & "#)"

        End If
        rs3.MoveNext
    Loop
    DoCmd.SetWarnings True
End Sub

Open in new window

Result:
Table x1(dt, tm)
dt                           tm
1/5/2013              12:32:00 PM
1/6/2013              12:33:00 PM
1/7/2013              12:34:00 PM

Why used rs3 instead of rs? because rs is already used in this sub, so I used a number to avoid duplicate declaration.
0
 
LVL 49

Expert Comment

by:Martin Liss
ID: 39593959
I also have to say that if the data is as freeform as it looks then the answer to the question is, as I implied in my first post, that it can't be done, and while I'm sure that isn't the answer you wanted, it is an answer.
0
 
LVL 30

Expert Comment

by:hnasr
ID: 39594008
Here is an example database, and I repeat from the previous comment to include the sample database.

You asked a question, and you deserve an answer. So don't be put off by any comment.

Here is a way:

You may need a way to organize such inputs in a table, then use queries to manipulate that table.

Assume original table x1(a1, a2)

a1      a2
1      1/5 1232
2      1/6/2013 1233
3      1234 1/7/2013

Code to create table x1t(dt, tm) and fill records from original table. You may modify x1t to include more fields, or you can update existing fields in another table.
Private Sub cmdCheck_Click()
    Dim rs3 As Recordset
    Dim rs3a() As String
    Set rs3 = CurrentDb.OpenRecordset("select a2 from x1")
    rs3.MoveFirst
    Dim i As Integer
    DoCmd.SetWarnings False
    DoCmd.RunSQL "Select #2013/01/01# as dt, #01:01# as tm into x1t From x1 where false"
    Do While Not rs3.EOF
        rs3a = Split(rs3(0), " ")
        
        If InStr(1, rs3a(0), "/") > InStr(1, rs3a(1), "/") Then
            '1st part is date
            '2nd part is time
            rs3a(0) = Format(rs3a(0), "yyyy/mm/dd")
            rs3a(1) = Format(Left(rs3a(1), 2) & ":" & Right(rs3a(1), 2), "hh:mm")
            
            DoCmd.RunSQL "Insert into x1t(dt, tm) values (#" & rs3a(0) & "#,#" & rs3a(1) & "#)"

        Else
            '1st part is time
            '2nd part is date
            rs3a(1) = Format(rs3a(1), "yyyy/mm/dd")
            rs3a(0) = Left(rs3a(0), 2) & ":" & Right(rs3a(0), 2)
            DoCmd.RunSQL "Insert into x1t(tm, dt) values (#" & rs3a(0) & "#,#" & rs3a(1) & "#)"

        End If
        rs3.MoveNext
    Loop
    DoCmd.SetWarnings True
End Sub

Open in new window

Result:
Table x1(dt, tm)
dt                           tm
1/5/2013              12:32:00 PM
1/6/2013              12:33:00 PM
1/7/2013              12:34:00 PM

Why used rs3 instead of rs? because rs is already used in this sub, so I used a number to avoid duplicate declaration.
split-date-time.accdb
0
 

Accepted Solution

by:
pflugg earned 0 total points
ID: 39595541
Did this and it worked fine.

Function RegexExtractDate(ByVal text As String, Optional seperator As String = "") As Date
    
    Dim i As Long, j As Long
    Dim interimresult As String
    Dim finalresult As String
    Dim allMatches As Object
    Dim RE As Object
    Set RE = CreateObject("vbscript.regexp")
    Dim pattern(11) As String
    Dim k As Integer
    Dim Match As Boolean
    
    
    pattern(1) = "\b(\d{1}/\d{2}/\d{4})\b"
    pattern(2) = "\b(\d{2}/\d{2}/\d{4})\b"
    pattern(3) = "\b(\d{1}/\d{1}/\d{4})\b"
    pattern(4) = "\b(\d{2}/\d{1}/\d{4})\b"
    
    pattern(5) = "\b(\d{1}/\d{2}/\d{2})\b"
    pattern(6) = "\b(\d{2}/\d{2}/\d{2})\b"
    pattern(7) = "\b(\d{1}/\d{1}/\d{2})\b"
    pattern(8) = "\b(\d{2}/\d{1}/\d{2})\b"
    
    pattern(9) = "\b(\d{1}/\d{2})\b"
    pattern(10) = "\b(\d{2}/\d{2})\b"
    pattern(11) = "\b(\d{1}/\d{1})\b"
    
    Match = False
    k = 1
    finalresult = ""
    
    Do Until Match = True Or k > 11
        interimresult = ""
        
        RE.pattern = pattern(k)
        RE.Global = True
        Set allMatches = RE.Execute(text)
        
        For i = 0 To allMatches.Count - 1
            For j = 0 To allMatches.Item(i).submatches.Count - 1
                interimresult = interimresult & seperator & allMatches.Item(i).submatches.Item(j)
            Next
        Next
        
        If Len(interimresult) <> 0 Then
            interimresult = Right(interimresult, Len(interimresult) - Len(seperator))
        End If
        
        If IsDate(interimresult) Then
            finalresult = interimresult
            Match = True
       End If
        k = k + 1
    Loop
    If IsDate(finalresult) Then
        RegexExtractDate = finalresult
    Else
        RegexExtractDate = "1/1/1901"
    End If
End Function

Function RegexExtractTime(ByVal text As String, Optional seperator As String = "") As Date
    
    Dim i As Long, j As Long
    Dim interimresult As String
    Dim finalresult As String
    Dim allMatches As Object
    Dim RE As Object
    Set RE = CreateObject("vbscript.regexp")
    Dim pattern(11) As String
    Dim k As Integer
    Dim Match As Boolean
    
    
    pattern(1) = "\b(\d{4})\b"
    
    Match = False
    k = 1
    finalresult = ""
    
    Do Until Match = True Or k > 1
        interimresult = ""
        
        RE.pattern = pattern(k)
        RE.Global = True
        Set allMatches = RE.Execute(text)
        
        For i = 0 To allMatches.Count - 1
            For j = 0 To allMatches.Item(i).submatches.Count - 1
                interimresult = interimresult & seperator & allMatches.Item(i).submatches.Item(j)
            Next
        Next
        
        If Len(interimresult) <> 0 Then
            interimresult = Right(interimresult, Len(interimresult) - Len(seperator))
            interimresult = Left(interimresult, 2) & ":" & Right(interimresult, 2)
        End If
        
        If IsDate(interimresult) Then
            finalresult = interimresult
            Match = True
       End If
        k = k + 1
    Loop
    If IsDate(finalresult) Then
        RegexExtractTime = finalresult
    Else
        RegexExtractTime = "00:00"
    End If
End Function

Open in new window

0
 
LVL 49

Expert Comment

by:Martin Liss
ID: 40394099
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

AutoNumbers should increment automatically, without duplicates.  But sometimes something goes wrong, and the next AutoNumber value is a duplicate.  This article shows how to recover from this problem.
This article describes a serious pitfall that can happen when deleting shapes using VBA.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

764 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question