Multiple Delimiters in Array

A

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!
 
M

Marshall Barton

Albert said:
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
Click to expand...

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
 
A

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.


Marshall Barton said:
Albert said:
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
Click to expand...

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
Click to expand...
 
A

Albert S.

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

Thanks!
--
Albert S.


Albert S. said:
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.


Marshall Barton said:
Albert said:
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
Click to expand...

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
Click to expand...
Click to expand...
 
M

Marshall Barton

Albert said:
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?
Click to expand...

Look it up in VBA Help. I forgot the dot in front of Index
so without the knowledge to proof read or debig the code,
you were pretty much doomed by my numerous typos. Help
explains that the Index property must be set to a string
containing the name of the index, which may or may not be
the same as the name of the field. You can find the list of
indexes by opening the table in design view and viewing the
Indexes window.
 
A

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!
 
M

Marshall Barton

Albert said:
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
Click to expand...


Well, of course, you did ask for ideas, not complete code.

If you are unfamilar with getting to a backend table
directly instead of through a link, the idea is to get the
path from the front en linked table and open the backend
database:

strBEpath = Mid(CurrentDb.TableDefs!linkedtable.Connect, 11)
Set db = OpenDatabase(strBEpath)

Now you can open a recordset on the back end table.
 
A

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!
 
A

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
 
M

Marshall Barton

Albert said:
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
Click to expand...


Looks fine to me. It's too bad you can't use a table type
recordset, it would incredibly faster to open the recordset
once and use Seek instead of having to open a recordset for
each token. If what you have proves to be too slow, you
might want to consider importing tblNames into a temp table
in a temp mdb so you could use Seek.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

AddPicturesToShapes 0
VBA Export to PDF 0
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
Remove Identical words 0
VBA-Table Word 2019 - Move a selected text, from a cell to the adjacent cell to its right, by pressing the ENTER key 0
Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0
SendObject action was cancelled 9
Word VBA - Delete text from bulleted paragraphs 1

Top