ExcelBanter - View Single Post

Ron Rosenfeld

On 27 Sep 2006 11:19:13 -0700, wrote:

Ron Rosenfeld wrote:
On 26 Sep 2006 10:49:41 -0700, wrote:

Once again, I messed up with my question/request. I am really sorry
that I am having such a dificult time being clear about things. The
user will fill in the dates any way they want. If the cell contains
only a date, then I can set the cell format to yyyy-mm-dd and then
whatever the user types in, Excel will re-format it and then when I
extract the date I will get the yyyy-mm-dd format. But, when other
text is in the cell with the date, the formatting doesn't work so then
I have to deal with a variety of date formats. Also, then I have to
re-format the dates through vba after validating the cell contents.
Maybe, I could first look for something that looks sort of like a date
and then pop up a message telling the user to format it like yyyy-mm-dd
if it does not match that format, then do the validation.

That changes the algorithm.

What we will do is first look at the first word in the string.

If the "word" is recognizable as a date by VBA; or if the word starts with an
"F", then we have a chance of the entry being valid and can do the rest of the
testing.

In addition, if the first word is recognizable as a date, we will reformat it
according to your specifications.

For now, and common to using Excel, we will require that the date includes
separators (i.e. 20061225 would not be valid). If this is an issue we can
address it subsequently.

Also, in your specifications, you also wrote:

"f1,f2,f3,f4,f5,f6 (multiples must be separated by a comma and no
space)"

Is this a requirement for data input, or not?

Yes, this is a requirement for data input, not my requirement, the
recipient wants it that way. If there is a footnote reference after a
date, there must be a space separating the date and the first footnote
reference.

Finally, once you have checked the data for validity, what do you want to do
with the data?

If you are going to split it out into separate cells, then what is the purpose
of the "no space" criterion?

Do you, perhaps, want it all in one cell formatted as specified?

All in one cell formatted as specified.
yyyy-mm-dd or
F1 (upper/lower case irrelevant) or
yyyy-mm-dd F1 or
yyyy-mm-dd F1,f2,f3 (F casing irrelevant)

Thanks again, I'm really stuck on how to check the date when it is
formatted in many different ways and mixed with text, or how to split
it from the footnote references to check it seperately.

--ron

OK. Try this.

The following will allow data input as follows:

The Date can be in any format recognizable by VBA. As far as I can tell, that
means that the entry must have some separator between the date portions. What
that means is that something like 20061225 would be invalid.

In addition, the footnotes must look like "F" (or "f") followed by 1 or 2
digits.

The output will be written in a cell in the adjacent column, in the format you
have specified.

This routine does NOT check for the absence of a <space after the footnote,
but it eliminates any spaces in the output.

Examples (view with a fixed pitch font):

INPUT OUTPUT
12/25/2006 2006-12-06
12/25/2006 G6 Invalid Entry
12/15/06 F1 2006-12-06 F1
12/15/06 F1,F2,F3,F4,F5,F6 2006-12-06 F1,F2,F3,F4,F5,F6
12-25-2006 f1, f11 2006-12-06 f1,f11
F1, f10, f99 F1,f10,f99

================================================== ======
Option Explicit
Sub Validate()
Dim c As Range
Dim ValidEntry As Boolean
Dim sDate As String
Dim i As Long
Dim sTemp As String
Dim sRes As String

'set reference to Regular Expression Library
Const s As String = "{3F4DACA7-160D-11D2-A8E9-00104B365C9F}"
Dim RegExpInstalled As Boolean
RegExpInstalled = False
With ThisWorkbook.VBProject.References
For i = 1 To .Count
If .Item(i).GUID = s Then RegExpInstalled = True
Next i
If RegExpInstalled = False Then
.AddFromGuid s, 0, 0
End If
End With

Const pFirstWord As String = "^\S+(\s|$)"
Const pFnum As String = "\b[Ff][1-9]\d?\b"

For Each c In Selection

'is first word a date?

sDate = REMid(c.Text, pFirstWord)
If IsDate(sDate) Then
sDate = Format(CDate(sDate), "yyyy-mm-yy")
sTemp = Replace(c.Text, REMid(c.Text, pFirstWord), "")
Else
sDate = ""
sTemp = c.Text
End If

sRes = sDate & " " 'Result starts with formatted date if present

'check that each word is a valid Fnum
For i = 1 To RECount(sTemp, "\w+")
If REMid(sTemp, "\w+", i) = REMid(sTemp, pFnum, i) Then
sRes = sRes & REMid(sTemp, pFnum, i) & ","
Else
sRes = "Invalid Entry "
Exit For
End If
Next i
sRes = Trim(Left(sRes, Len(sRes) - 1))
Debug.Print c.Text & " converts to: " & sRes
c.Offset(0, 1).Value = sRes
Next c

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