Solved

Search non-standard string for date/time values

Posted on 2013-10-22
12
137 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 47

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
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 
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 47

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 47

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

The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

Question has a verified solution.

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

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
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 …

739 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