Multiple Delimiters in Array

[Albert S.]

Hello,

I am trying to create a new Proper Case function that will compare words in
a field to a table (tblNames) containing the correct capitalization we want
to use.

For instance Roman numerals, certain codes, abbreviations, foreign words etc.

I was thinking of breaking the data into an array with space as the
delimiter, but I also need to examine words that are adjacent to or are
embedded in characters such as:

word1 word2 word3 Hob.iii.3a.

Hob.iii.3a needs to be Hob.III.3a - propercase for Hob. (not in table),
lookup in table for iii (in table as III) and proper case for 3a (not in
table).

I only have to catch these characters (I hope!): / - [ ] { } . ; : ( )

So what I want to do is use the split() funtion to create an array of each
word so I can match them to the table, but this would entail multiple
delimiters.

I was thinking to delimit by space first then by the symbols, but wasn't
sure how to get an array from more than one delimiter.

Here is what I have so far:

Public Function NewProperLookup(ByVal InText As Variant) As Variant
Dim OutText As String
Dim i As Integer
Dim j As Integer
Dim D As String
Dim strWord As String
Dim arrTitle As Variant
Dim db As Database
Dim rs As DAO.Recordset
Dim cSQL As String
Dim strLook As String
Dim intSection As Integer
Dim blnForce As Boolean

Set db = CurrentDb

If VarType(InText) <> 8 Then
NewProperLookup = InText
Else
arrTitle = split(InText, " ", -1, vbTextCompare)
For i = 0 To UBound(arrTitle)
Debug.Print arrTitle(i)
strLook = arrTitle(i)
cSQL = "SELECT [Name] FROM tblNames WHERE [Name] = " & Chr(34) &
strLook & Chr(34)
Set rs = db.OpenRecordset(cSQL)
If rs.BOF And rs.EOF Then 'no match - process word
If IsAlpha(strLook) Then
OutText = Trim(OutText & " " & UCase(Left(strLook, 1)) &
LCase(Mid(strLook, 2)))
Else
blnForce = False
strWord = ""
For j = 1 To Len(strLook) 'force an uppercase after a
symbol
D = Mid(strLook, j, 1)
If blnForce Then
D = UCase(D)
blnForce = False
End If
If D = "/" Or D = "-" Or D = "{" Or D = "}" Or D =
"[" Or D = "]" Or D = "." Or D = ";" _
Or D = ":" Or D = "(" Or D = ")" Then
blnForce = True
End If
strWord = strWord & D
Next j
OutText = Trim(OutText & " " & strWord)
End If
Else
strLook = rs!Name
OutText = OutText & " " & strLook
End If
Next i
db.Close
NewProperLookup = OutText
End If

End Function

Any suggestions appreciated!

 

[Albert S.]

Hello,

Thanks for the suggestions. I am getting an error message on the line:
Index = "your item field index"

I put Index = 0, but get a "Variable Not Defined" error. Is this a variable?

Thanks!

--
Albert S.

I am trying to create a new Proper Case function that will compare words in
a field to a table (tblNames) containing the correct capitalization we want
to use.

For instance Roman numerals, certain codes, abbreviations, foreign words etc.

I was thinking of breaking the data into an array with space as the
delimiter, but I also need to examine words that are adjacent to or are
embedded in characters such as:

word1 word2 word3 Hob.iii.3a.

Hob.iii.3a needs to be Hob.III.3a - propercase for Hob. (not in table),
lookup in table for iii (in table as III) and proper case for 3a (not in
table).

I only have to catch these characters (I hope!): / - [ ] { } . ; : ( )

So what I want to do is use the split() funtion to create an array of each
word so I can match them to the table, but this would entail multiple
delimiters.

I was thinking to delimit by space first then by the symbols, but wasn't
sure how to get an array from more than one delimiter.

Here is what I have so far:

Public Function NewProperLookup(ByVal InText As Variant) As Variant
Dim OutText As String
Dim i As Integer
Dim j As Integer
Dim D As String
Dim strWord As String
Dim arrTitle As Variant
Dim db As Database
Dim rs As DAO.Recordset
Dim cSQL As String
Dim strLook As String
Dim intSection As Integer
Dim blnForce As Boolean

Set db = CurrentDb

If VarType(InText) <> 8 Then
NewProperLookup = InText
Else
arrTitle = split(InText, " ", -1, vbTextCompare)
For i = 0 To UBound(arrTitle)
Debug.Print arrTitle(i)
strLook = arrTitle(i)
cSQL = "SELECT [Name] FROM tblNames WHERE [Name] = " & Chr(34) &
strLook & Chr(34)
Set rs = db.OpenRecordset(cSQL)
If rs.BOF And rs.EOF Then 'no match - process word
If IsAlpha(strLook) Then
OutText = Trim(OutText & " " & UCase(Left(strLook, 1)) &
LCase(Mid(strLook, 2)))
Else
blnForce = False
strWord = ""
For j = 1 To Len(strLook) 'force an uppercase after a
symbol
D = Mid(strLook, j, 1)
If blnForce Then
D = UCase(D)
blnForce = False
End If
If D = "/" Or D = "-" Or D = "{" Or D = "}" Or D =
"[" Or D = "]" Or D = "." Or D = ";" _
Or D = ":" Or D = "(" Or D = ")" Then
blnForce = True
End If
strWord = strWord & D
Next j
OutText = Trim(OutText & " " & strWord)
End If
Else
strLook = rs!Name
OutText = OutText & " " & strLook
End If
Next i
db.Close
NewProperLookup = OutText
End If

End Function

I don't think Split is all that useful here. It may be
simpler to just us a loop through each character and save
the item and following delimiter in a 2D array:

Dim Tokens(999,2) As String
Dom j As Long, k As Long
j = 0
strt = 1
For k = 1 to Len(InText)
If Mid(InText,k,1) Like "[!a-z0-9]" Then
Tokens(j,1) = Mid(InText,strt,k-1)
Tokens(j,2) = Mid(InText,k,1)
strt = k+1
j = j+1
End If
Next k

Then you can loop through the Tokens array checking each
item against your table.

To speed up the table search, you should open a table type
recordset. Then you can use Seek to find the replacement
token very quickly.

With db.OpenRecordset(tblitems, dbOpenTable)
Index = "your item field index"
For k = 0 to j-1
.Seek "=", Tokens(k,1)
If .Nomatch Then
NewProperLookup = NewProperLookup _
& Tokens(k,1) & Tokens(k,2)
Else
NewProperLookup = NewProperLookup _
& !itemfield & Tokens(k,2)
End If
Next k
End With

 

[Albert S.]

Should have explained that we are using Access2003/SQLServer2005 - the lookup
table is a linked table.

Thanks!
--
Albert S.

Hello,

Thanks for the suggestions. I am getting an error message on the line:
Index = "your item field index"

I put Index = 0, but get a "Variable Not Defined" error. Is this a variable?

Thanks!

--
Albert S.

I am trying to create a new Proper Case function that will compare words in
a field to a table (tblNames) containing the correct capitalization we want
to use.

For instance Roman numerals, certain codes, abbreviations, foreign words etc.

I was thinking of breaking the data into an array with space as the
delimiter, but I also need to examine words that are adjacent to or are
embedded in characters such as:

word1 word2 word3 Hob.iii.3a.

Hob.iii.3a needs to be Hob.III.3a - propercase for Hob. (not in table),
lookup in table for iii (in table as III) and proper case for 3a (not in
table).

I only have to catch these characters (I hope!): / - [ ] { } . ; : ( )

So what I want to do is use the split() funtion to create an array of each
word so I can match them to the table, but this would entail multiple
delimiters.

I was thinking to delimit by space first then by the symbols, but wasn't
sure how to get an array from more than one delimiter.

Here is what I have so far:

Public Function NewProperLookup(ByVal InText As Variant) As Variant
Dim OutText As String
Dim i As Integer
Dim j As Integer
Dim D As String
Dim strWord As String
Dim arrTitle As Variant
Dim db As Database
Dim rs As DAO.Recordset
Dim cSQL As String
Dim strLook As String
Dim intSection As Integer
Dim blnForce As Boolean

Set db = CurrentDb

If VarType(InText) <> 8 Then
NewProperLookup = InText
Else
arrTitle = split(InText, " ", -1, vbTextCompare)
For i = 0 To UBound(arrTitle)
Debug.Print arrTitle(i)
strLook = arrTitle(i)
cSQL = "SELECT [Name] FROM tblNames WHERE [Name] = " & Chr(34) &
strLook & Chr(34)
Set rs = db.OpenRecordset(cSQL)
If rs.BOF And rs.EOF Then 'no match - process word
If IsAlpha(strLook) Then
OutText = Trim(OutText & " " & UCase(Left(strLook, 1)) &
LCase(Mid(strLook, 2)))
Else
blnForce = False
strWord = ""
For j = 1 To Len(strLook) 'force an uppercase after a
symbol
D = Mid(strLook, j, 1)
If blnForce Then
D = UCase(D)
blnForce = False
End If
If D = "/" Or D = "-" Or D = "{" Or D = "}" Or D =
"[" Or D = "]" Or D = "." Or D = ";" _
Or D = ":" Or D = "(" Or D = ")" Then
blnForce = True
End If
strWord = strWord & D
Next j
OutText = Trim(OutText & " " & strWord)
End If
Else
strLook = rs!Name
OutText = OutText & " " & strLook
End If
Next i
db.Close
NewProperLookup = OutText
End If

End Function

I don't think Split is all that useful here. It may be
simpler to just us a loop through each character and save
the item and following delimiter in a 2D array:

Dim Tokens(999,2) As String
Dom j As Long, k As Long
j = 0
strt = 1
For k = 1 to Len(InText)
If Mid(InText,k,1) Like "[!a-z0-9]" Then
Tokens(j,1) = Mid(InText,strt,k-1)
Tokens(j,2) = Mid(InText,k,1)
strt = k+1
j = j+1
End If
Next k

Then you can loop through the Tokens array checking each
item against your table.

To speed up the table search, you should open a table type
recordset. Then you can use Seek to find the replacement
token very quickly.

With db.OpenRecordset(tblitems, dbOpenTable)
Index = "your item field index"
For k = 0 to j-1
.Seek "=", Tokens(k,1)
If .Nomatch Then
NewProperLookup = NewProperLookup _
& Tokens(k,1) & Tokens(k,2)
Else
NewProperLookup = NewProperLookup _
& !itemfield & Tokens(k,2)
End If
Next k
End With

 

[Albert S.]

Ok, I saw that the period was missing from the Index and I got the Index name
"PK_tblNames".

But, when I get to this line there is an Invalid Operation error:

With db.OpenRecordset("tblNames", dbOpenTable)

I have done these:
Dim db As Database
Set db = CurrentDb

Thanks!

 

[Albert S.]

Yes, no problem! Thank you for the ideas...

This didn't work:
strBEpath = Mid(CurrentDb.TableDefs!tblNames.Connect, 11)
Set db = OpenDatabase(strBEpath)

The backend database is on a different computer in SQLServer.

I see what you are getting at with the tokens and I think I can make it
work. I will post back with any success or failure...

Thanks!

 

[Albert S.]

Ok, got it to work. Thanks!
I had to change the Tokens(j, 1) to equal Mid(InText, strt, k - strt)
instead of Mid(InText, strt, k - 1). That way the starting point moved over
to the start of the next word.

Here is the finished function - maybe not the most efficient -

Public Function NewProperLookup(ByVal InText As Variant) As Variant
Dim Tokens(999, 2) As String
Dim j As Long
Dim k As Long
Dim strt As Long
Dim db As Database
Dim rs As DAO.Recordset
Dim cSQL As String
Dim strLook As String
Dim OutText As String
Dim strChar As String

Set db = CurrentDb

InText = Trim(InText) 'remove and leading or trailing spaces
Do Until InStr(1, InText, " ", vbTextCompare) = 0 'remove all double
spaces
InText = Replace(InText, " ", " ", 1)
Loop

j = 0
strt = 1
For k = 1 To Len(InText)
If Mid(InText, k, 1) Like "[!a-z0-9]" Then
Tokens(j, 1) = Mid(InText, strt, k - strt)
Tokens(j, 2) = Mid(InText, k, 1)
strt = k + 1
j = j + 1
End If
Next k

For k = 0 To j - 1
strLook = Tokens(k, 1)
strChar = Tokens(k, 2)
cSQL = "SELECT [Name] FROM tblNames WHERE [Name] = " & Chr(39) &
strLook & Chr(39)
Set rs = db.OpenRecordset(cSQL)
If rs.BOF And rs.EOF Then 'no match
OutText = OutText & UCase(Left(strLook, 1)) & LCase(Mid(strLook,
2)) & strChar
Else 'word matched
strLook = rs!Name
OutText = OutText & strLook & strChar
End If
Next k

NewProperLookup = Trim(OutText)

End Function