On Thu, 6 Apr 2006 15:55:19 -0500, jay
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