Find each date in a memo field

[jom1918]

Memo field is called [Notes] and data is like this...

5/05/14 - Perry was on another call. LM 2/05/14 - Perry only at centre in the mornings, need to speak to him before sending samples. 13/06/13 - Perry in a meeting. lm 30/05/13 - See Little Hampton Early Learning - s/w Perry, has already received sample and info 29/05/13 - s/w Aspi, said to cb tommorrow and speak to Perry

I want to find each date in the Notes field so I can split the memo field data into another table where the memo field will become multiple records that hold date, text and customer/prospect ID fields. The customer table was easy because there was a <Div> tag before each date. However in the Prospects table there are no tags so I need some help understanding how to change my vba code to search for each date before I split off the data.

Here is the part of the VBA code I used to find the <Div> tag in the customer notes field. Can anyone tell me how to find each date in the memo field? The date is in d/mm/yy format?

If Not rst.EOF Then
Do
StrSplit = Split(rst![Notes], "<Div>")
For x = 1 To UBound(StrSplit)

 

[cheekybuddha]

Hi,

There are a couple of ways to do this, but since you are familiar with Split() I would suggest using that function again with " " (a space) as the delimiter.

You would then need to loop through the resultant array testing each element to see if it is a date, and 'reconstruct' the notes until you hit the next date.

There might be an issue if your user has not entered the note consistently eg the note looks like:
" ... to speak to him before sending samples.13/06/13 - Perry in a meeting...."

If this might be the case, then you can create a function that loops through the fields letter by letter - when it hits a numeric it tests the next few letters to see if you have a date or not, but this would be more fiddly (and perhaps a bit slower).

The other issue is if the actual notes contain dates, eg:
5/05/14 - Perry was on another call. Said he would call back on 06/05/14 ...

There is no real way of distinguishing something like the above.

Shout if you need help with the code.

hth,

d

------------
David Marten

 

[JHB]

It is (almost) impossible to find dates and related texts because there is no clear starting and stopping points, like dots etc.

 

[spikepl]

Use RegExp (but that's not simple for beginners) or self-made pattern matching with InStr function to find each instance of date. First search for location of pattern dd/mm/yy and then for d/mm/yy.

Check this: http://www.mrexcel.com/forum/excel-...instr-recognize-code-format-no-character.html

 

[vbaInet]

Use RegExp (but that's not simple for beginners)...
Check this: http://www.mrexcel.com/forum/excel-...instr-recognize-code-format-no-character.html

Here's a good link too which shows all its methods, collections and properties:
http://msdn.microsoft.com/en-us/library/ms974570.aspx

In any case, since all your dates tend to have a backslash "/" you can loop through using InStr() to find that occurrence, use that Index-1 or Index-2 as your new position then use IsDate() to validate the next 7 (i.e. 5/05/14) or 8 (i.e. 30/05/13) characters from both new positions.

The other thing also is, to speed things up, you can split the string using dot(.) as the delimeter and finding the date within each substring. Not the best way because a sentence may have more than one dot but it's another way to try.

 

[vbaInet]

Something like this:

Type DateOccurs
    Count As Integer
    Items() As String
    StringDates() As String
End Type

Function GetDateOccurs(ByVal TheString As Variant) As DateOccurs

    If Len(TheString & vbNullString) = 0 Then Exit Function
    
    Const BYT_MMYY      As Byte = 5
    Const INT_UBOUND    As Integer = 1000   ' Change this threshold where necessary
    
    Dim x               As Integer
    Dim y               As Integer
    Dim intPos          As Integer
    Dim intLen          As Integer
    Dim bytLenDate      As Byte
    Dim blIsDate        As Boolean
    Dim arrOccurs()     As String
    Dim arrDates()      As String
    
    ReDim arrOccurs(INT_UBOUND)
    ReDim arrDates(INT_UBOUND)
    intLen = Len(TheString)
    
    For x = Len(TheString) To 1 Step -1
        intPos = InStrRev(TheString, "/", x)
        
        If intPos > 0 Then
            
            ' Check that it's formatted as a date, then check that it's a valid date.
            ' Must first do a LIKE check otherwise a date like " 1/1/14" will pass _
              one of the first two IsDate checks if one or more spaces precedes it.
            
            If Mid(TheString, intPos - BYT_MMYY, 8) Like "##/##/*" Then
            
                If IsDate(Mid(TheString, intPos - BYT_MMYY, 8)) Then
                    intPos = intPos - BYT_MMYY
                    bytLenDate = 8
                    blIsDate = True
                End If
                
            ElseIf Mid(TheString, intPos - (BYT_MMYY - 1), 7) Like "#[0-9/][0-9/]#/*" Then
            
                If IsDate(Mid(TheString, intPos - (BYT_MMYY - 1), 7)) Then
                    intPos = intPos - (BYT_MMYY - 1)
                    bytLenDate = 7
                    blIsDate = True
                End If
                
            ElseIf Mid(TheString, intPos - (BYT_MMYY - 2), 6) Like "#/#/*" Then
                
                If IsDate(Mid(TheString, intPos - (BYT_MMYY - 2), 6)) Then
                    intPos = intPos - (BYT_MMYY - 2)
                    bytLenDate = 6
                    blIsDate = True
                End If
                
            End If
            
            ' If date, save in array
            If blIsDate Then
                
                If UBound(arrOccurs) < y Then
                    ReDim Preserve arrOccurs(y + INT_UBOUND)
                    ReDim Preserve arrDates(y + INT_UBOUND)
                End If
                
                arrOccurs(y) = Mid(TheString, intPos, intLen - (intPos - 1))
                arrDates(y) = Mid(TheString, intPos, bytLenDate)
                
                x = intPos
                intLen = intPos - 1
                y = y + 1
                blIsDate = False
                
            End If
        End If
    Next
    
    ReDim Preserve arrOccurs(y - 1)
    ReDim Preserve arrDates(y - 1)
    
    With GetDateOccurs
        .Items = arrOccurs
        .StringDates = arrDates
        .Count = y
    End With
    
End Function

To use:

For a count:
?GetDateOccurs("Your text").Count

For the date part (String):
?GetDateOccurs("Your text").DatesString([COLOR="Red"]0[/COLOR])

For each section (read backwards and begins with the date):
?GetDateOccurs("Your text").Items([COLOR="red"]0[/COLOR])

A couple of things to note:
1. It reads backwards (i.e. the last index is the first occurrence) so you can extend the function to flip the returned array over or just read it from the Ubound() to the LBound()
2. You need to trim off line breaks. You can write a quick function for this.
3. It would only pick date formats that are like x/x/xx, x/xx/xx, xx/x/xx or x/x/xx. Must be 2 digits for year and it will pick any combination of day/month. Of course it won't work for any other date variants like 22 July 14.
4. It would attempt to read from the date onwards (not the other way round like others have mentioned) so note this.
5. StringDates returns a date string to preserve the formatting.
6. Not tested fully.

Anyway, this was only a bit of fun so I would still go for the RegEx option spikepl mentioned.

 

[jom1918]

Thanks everyone. I am going to try to learn RegExp which I don;t think will be easy, but I will give it a go. I will also try the code offered by all of you as well. I will use a copy of the data so I don't screw up the live database.