Help !, to find last 'text' date in text string

[jay]

Newbie needs help, finding last 'text' date in text string !

I am trying to determine how many days ago (from TODAY or DATE) was a
entry into a 'text' cell made, but I don't know to find the end of the text and
search backward for the last date.

In the cell are multiple text entries preceeded by the date of the entry, with the most recent entry appended to the end of the cells current text string.

The typical text of the cell looks like below (note: the date entry is
always shown as: ", mm/dd/yyyy:")

lots of text,,more text,, , 12/28/2005: lots of text,,more text,, r
, 12/29/2005: Sent e-mail lots of text,,more text,, r , 12/30/2005:
lots of text,,more text,, r , 1/17/2006: lots of text,,more text,, ,
1/19/2006: lots of text,,more text,, , 1/27/2006: lots of
text,,more text,, , 1/30/2006: lots of text,,more text,, ,
3/1/2006: lots of text,,more text,, , 3/1/2006: lots of text,,more
text, text end.


I think the pseudo code approach would look similiar to:

dim todaydate as date
dim founddate as ??
dim count as integer

todaydate = date 'get and save todays date

range(the_text_cell).value.select
with selection
.find ( here is where I am lost)
[probably need something here to convert the found date 'text' value to date type]
count = todaydate - founddate


Thanks for any help you can provide :-)

[Ron Rosenfeld]

On Thu, 6 Apr 2006 15:55:19 -0500, jay
<[email protected]> wrote:

>
>Newbie needs help, finding last 'text' date in text string !
>
>I am trying to determine how many days ago (from TODAY or DATE) was a
>entry into a 'text' cell made, but I don't know to find the end of the
>text and
>search backward for the last date.
>
>In the cell are multiple text entries preceeded by the date of the
>entry, with the most recent entry appended to the end of the cells
>current text string.
>
>The typical text of the cell looks like below (note: the date entry is
>always shown as: ", mm/dd/yyyy:")
>
>lots of text,,more text,, , 12/28/2005: lots of text,,more text,,
>r
>, 12/29/2005: Sent e-mail lots of text,,more text,, r , 12/30/2005:
>lots of text,,more text,, r , 1/17/2006: lots of text,,more text,,
>,
>1/19/2006: lots of text,,more text,, , 1/27/2006: lots of
>text,,more text,, , 1/30/2006: lots of text,,more text,, ,
>3/1/2006: lots of text,,more text,, , 3/1/2006: lots of
>text,,more
>text, text end.
>
>
>I think the pseudo code approach would look similiar to:
>
>dim todaydate as date
>dim founddate as ??
>dim count as integer
>
>todaydate = date 'get and save todays date
>
>range(the_text_cell).value.select
>with selection
> .find ( here is where I am lost)
>[probably need something here to convert the found date 'text'
>value to date type]
>count = todaydate - founddate
>
>
>Thanks for any help you can provide :-)

My suggestion would be to set a reference (Tools/References) to

Microsoft VBScript Regular Expressions 5.5

and then use a Regular Expression to obtain the last date in the string.

With the string you gave as an example in A1, the following seems to do what
you want:

==========================
Option Explicit
Sub GetLastDate()
Dim rg As Range
Dim LastDate As Date
Dim DaysSinceLastDate As Long

'pattern to detect a string that looks like a date
'in this case defined as 1 or 2 digits followed by
'a slash; repeated twice; and followed by four digits
'if necessary, it could be made more specific to ensure
'only valid dates if there is a chance that non-valid date
'sequences could be confused.

Const Regex As String = "(\d{1,2}/){2}\d{4}"

Set rg = [A1]

LastDate = REMid(rg.Text, Regex, RECount(rg.Text, Regex))
DaysSinceLastDate = Date - LastDate

Debug.Print "Last Date: " & LastDate & " is " & DaysSinceLastDate & " days ago"
End Sub

'------------------------------------------------
Function REMid(str As String, Pattern As String, _
Optional Index As Variant = 1, _
Optional CaseSensitive As Boolean = True) _
As Variant 'Variant as value may be string or array

Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection

Dim i As Long 'counter
Dim t() As String 'container for array results

' Create a regular expression object.
Set objRegExp = New RegExp

'Set the pattern by using the Pattern property.
objRegExp.Pattern = Pattern

' Set Case Insensitivity.
objRegExp.IgnoreCase = Not CaseSensitive

'Set global applicability.
objRegExp.Global = True

'Test whether the String can be compared.
If (objRegExp.Test(str) = True) Then

'Get the matches.
Set colMatches = objRegExp.Execute(str) ' Execute search.

On Error Resume Next 'return null string if a colmatch index is non-existent
If IsArray(Index) Then
ReDim t(1 To UBound(Index))
For i = 1 To UBound(Index)
t(i) = colMatches(Index(i) - 1)
Next i
REMid = t()
Else
REMid = CStr(colMatches(Index - 1))
If IsEmpty(REMid) Then REMid = ""
End If
On Error GoTo 0 'reset error handler
Else
REMid = ""
End If
End Function
Function RECount(str As String, Pattern As String, _
Optional CaseSensitive As Boolean = True) As Long

Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection

' Create a regular expression object.
Set objRegExp = New RegExp

'Set the pattern by using the Pattern property.
objRegExp.Pattern = Pattern

' Set Case Insensitivity.
objRegExp.IgnoreCase = Not CaseSensitive

'Set global applicability.
objRegExp.Global = True

'Test whether the String can be compared.
If (objRegExp.Test(str) = True) Then

'Get the matches.
Set colMatches = objRegExp.Execute(str) ' Execute search.
RECount = colMatches.Count
Else
RECount = 0
End If
End Function
=============================
--ron

[jay]

Ron,

You've done some marvelous work here and I truly appreciate it.

However, when I attempt to run the macro I get a pop-up error window of:

(Microsoft Visual Basic)
"Compiler error:"
"User defined type, not defined"

It occurs on the line of:

Dim objRegExp As RegExp -> wherein the line is colored BLUE

However, the lines above it are colored yellow, which are:

Function RECount(str As String, Pattern As String, _
Optional CaseSensitive As Boolean = True) As Long


QUESTION:
Did I do something wrong in my paste of the code ?

I'm using Windows2000 Professional
and Excel 2002 w/SP3

Thanks for all your help,

[Ron Rosenfeld]

On Fri, 7 Apr 2006 12:59:23 -0500, jay
<[email protected]> wrote:

>
>Ron,
>
>You've done some marvelous work here and I truly appreciate it.
>
>However, when I attempt to run the macro I get a pop-up error window
>of:
>
>(Microsoft Visual Basic)
>"Compiler error:"
>"User defined type, not defined"
>
>It occurs on the line of:
>
>Dim objRegExp As RegExp -> wherein the line is colored BLUE
>
>However, the lines above it are colored yellow, which are:
>
>Function RECount(str As String, Pattern As String, _
>Optional CaseSensitive As Boolean = True) As Long
>
>
>QUESTION:
>Did I do something wrong in my paste of the code ?
>
>I'm using Windows2000 Professional
>and Excel 2002 w/SP3
>
>Thanks for all your help,

Your code pasting is probably OK.

I believe you overlooked the part of my instructions to set a reference to
VBScript:

---------------------------------------
My suggestion would be to set a reference (Tools/References) to

Microsoft VBScript Regular Expressions 5.5
--------------------------------------

On the menu bar at the top of the VBEditor, you will see an option "Tools".

Select this and then "References" from the drop-down menu. In there you will
see the above named reference. Place a check mark in the box next to it and
all should be well.

--ron

[jay]

Ron,

You don't know how greatful I am for you intellectual help :-)

Yes, the Tools -> Reference issue solved the problem and produced the correct results, as verified in several cells of my SS with the same type of data.

I hope that some day I might have something near the skill set that you have, but from the complexity of your code, this will still be some time off in the future... Thanks for being there !

Jay,,,,,real name Jerry

[Ron Rosenfeld]

On Fri, 7 Apr 2006 15:00:21 -0500, jay
<[email protected]> wrote:

>
>Ron,
>
>You don't know how greatful I am for you intellectual help :-)
>
>Yes, the Tools -> Reference issue solved the problem and produced the
>correct results, as verified in several cells of my SS with the same
>type of data.
>
>I hope that some day I might have something near the skill set that you
>have, but from the complexity of your code, this will still be some time
>off in the future... Thanks for being there !
>
>Jay,,,,,real name Jerry

Jerry,

If you do a web search for "Regular Expressions" you will find all sorts of
useful information.

In addition, you can download and install Longre's free morefunc.xll add-in
from http://xcell05.free.fr

It has, among other things, a number of regular expression formulas. It would
be useful for learning. It was not appropriate for this problem because of a
string length limitation of 255 characters; but it is quite useful with shorter
text length processing.

Best wishes,
--ron

[jay]

Hi there (maybe Ron)

In an effort to loop through my cells containing the date values, I have constructed a 'while' loop, whereby "Temp" is a counter variable.

Your expression of:

Set rg = [A31] <-- this works perfectly for an individual cell ! :-)

however, my coding for the 'while' loop causes and error. Here is my code:

Dim Cell_Item 'assumes a variant
Dim Temp As Integer
Temp = 4 'ASSUMES FIRST ROW OF COMMENTS IS IN ROW 4


Const Regex As String = "(\d{1,2}/){2}\d{4}"

While Temp < LastRow + 1
Set Cell_Item = Range("Q" & Temp).Cells


Set rg = [Cell_Item] <-- I get a compiler error here

NOTE: My first effort was to do as follows:

Set rg = ("Q" & Temp) <- also produces an error

[Ron Rosenfeld]

On Mon, 10 Apr 2006 14:53:51 -0500, jay
<[email protected]> wrote:

>
>Hi there (maybe Ron)
>
>In an effort to loop through my cells containing the date values, I
>have constructed a 'while' loop, whereby "Temp" is a counter variable.
>
>Your expression of:
>
>Set rg = [A31] <-- this works perfectly for an individual cell !
>:-)
>
>however, my coding for the 'while' loop causes and error. Here is my
>code:
>
>Dim Cell_Item 'assumes a variant
>Dim Temp As Integer
>Temp = 4 'ASSUMES FIRST ROW OF COMMENTS IS IN ROW 4
>
>
>Const Regex As String = "(\d{1,2}/){2}\d{4}"
>
>While Temp < LastRow + 1
>Set Cell_Item = Range("Q" & Temp).Cells
>
>
>Set rg = [Cell_Item] <-- I get a compiler error here
>
>NOTE: My first effort was to do as follows:
>
>Set rg = ("Q" & Temp) <- also produces an error


There's some other problem in code that you have not posted.

Here's an example that works and includes code syntax similar to what you've
posted, except changed to reference A1:A13. I only included the first Sub and
not the RE...functions:

====================================
Sub GetLastDates()
Dim rg As Range
Dim LastDate As Date
Dim DaysSinceLastDate As Long

'pattern to detect a string that looks like a date
'in this case defined as 1 or 2 digits followed by
'a slash; repeated twice; and followed by four digits
'if necessary, it could be made more specific to ensure
'only valid dates if there is a chance that non-valid date
'sequences could be confused.

Const Regex As String = "(\d{1,2}/){2}\d{4}"

Dim Cell_Item 'assumes a variant
Dim Temp As Integer
Temp = 1 'ASSUMES FIRST ROW OF COMMENTS IS IN ROW 4
Const LastRow As Integer = 13

While Temp < LastRow + 1
Set Cell_Item = Range("A" & Temp).Cells
Set rg = [Cell_Item]

LastDate = REMid(rg.Text, Regex, RECount(rg.Text, Regex))
DaysSinceLastDate = Date - LastDate

Debug.Print "Last Date: " & LastDate & " is " & DaysSinceLastDate & " days ago"

Temp = Temp + 1
Wend

End Sub
==========================


--ron