View Single Post
  #16   Report Post  
Posted to microsoft.public.excel.programming
[email protected] rcmail14872@yahoo.com is offline
external usenet poster
 
Posts: 13
Default parse cell contents

Thank you so much for the code. With the last code, the one the sets a
reference, I get the following error message: "Programmatic access to
Visual Basic Project is not trusted", probably because I am working on
a corporate pc that as restricted access rights. Regarding the
morefunc add-in where do I find the Menu option
to embed it within the worksheet, is this something I have to set?

With the other code, that has this line:

ValidEntry = IsDate(strDate) Or Left(c.Text, 1) Like "[Ff]"

the problem is that dates are not recognized when they are accompanied
by other text. Maybe the solution is to require the user to put the
date (or no date) in one cell and any (if any) accompanying footnote
references in the following cell, then for my purposes of having the
data together, I can validate the separate cells first, then combine
the contents of both cells into a hidden cell. If would be a whole lot
easier to validate the cell contents if the cell didn't have both
dates, and text. Especially when the dates are formatted randomly
because the built in cell formatting for dates won't work if the cell
contains both a date and text.

Ron Rosenfeld wrote:
On Fri, 22 Sep 2006 22:02:34 -0400, Ron Rosenfeld
wrote:

Here is an example where the data is split into adjacent columns only if it is
valid. If invalid, a message is placed in the adjacent column:

======================================
Option Explicit

Sub Validate()
Dim c As Range
Dim strDate As String
Dim strF As String
Dim i As Long
Dim ValidEntry As Boolean
Dim sTemp As String

Const PatternDate As String = "^\d{4}-\d{2}-\d{2}\b"
Const PatternF As String = "(" & PatternDate & _
")?" & "((^|\s)(F\d{1,2}(,|$))*)?"
'Not good form to make both parts of the regex _
optional, but it'll work because of other code below

For Each c In Selection
strDate = Run([regex.mid], c.Text, PatternDate)
ValidEntry = IsDate(strDate) Or Left(c.Text, 1) Like "[Ff]"

If ValidEntry = True Then
strF = Run([regex.mid], c.Text, PatternF, , False)
ValidEntry = (strF = c.Text)
End If
Debug.Print c.Text & " " & ValidEntry

If ValidEntry = True Then
If strDate < "" Then
c.Offset(0, 1).Value = strDate
c.Offset(0, 1).NumberFormat = "yyyy-mm-dd"
End If

For i = 1 To Run([regex.count], strF, "F\d+", False)
c.Offset(0, i + 1).Value = Run([regex.mid], strF, "F\d+", i, False)
Next i
Else
c.Offset(0, 1).Value = "Invalid Entry"
End If
Next c

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

--ron



By the way, if you really don't want to use morefunc.xll, you can try this
variation, which might work. It, hopefully, will set a reference to Microsoft
VBScript Regular Expressions 5.5 and use some custom functions.

I wrote it as an exercise, to try to learn about setting references
programmatically.

==================================
Option Explicit
Sub Validate()
Dim c As Range
Dim strDate As String
Dim strF As String
Dim i As Long
Dim ValidEntry As Boolean
Dim sTemp 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 PatternDate As String = "^\d{4}-\d{2}-\d{2}\b"
Const PatternF As String = "(" & PatternDate & _
")?" & "((^|\s)(F\d{1,2}(,|$))*)?"
'Not good form to make both parts of the regex _
optional, but it'll work because of other code below

For Each c In Selection
strDate = REMid(c.Text, PatternDate)
ValidEntry = IsDate(strDate) Or Left(c.Text, 1) Like "[Ff]"

If ValidEntry = True Then
strF = REMid(c.Text, PatternF, , False)
ValidEntry = (strF = c.Text)
End If
Debug.Print c.Text & " " & ValidEntry

If ValidEntry = True Then
If strDate < "" Then
c.Offset(0, 1).Value = strDate
c.Offset(0, 1).NumberFormat = "yyyy-mm-dd"
End If

For i = 1 To RECount(strF, "F\d+", False)
c.Offset(0, i + 1).Value = REMid(strF, "F\d+", i, False)
Next i
Else
c.Offset(0, 1).Value = "Invalid Entry"
End If
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