I just got this working so I apologize, it has yet to be cleaned up and I have never used the code window for display here and did not see any instructions for it.
I understand the maintainability issue and it is real. In a case where there is one statement (GoTo nextCsz) used several times it is quite clear what is going on. It is possible that I overestimated the time savings but this takes 50% more time than the alternative even now. The cleanup will yield some additional savings but I may not get to do much because of the deadlines imposed and other customer work.
I am curious what you all think.
Thanks,
alr
Private Sub cmdParse_Click()
On Error GoTo Err_cmdParse_Click
Dim varNewCsz As Variant
Dim varLenCsz(0 To 20) As Integer
Dim intNumComp As Integer
Dim i As Integer 'counter
Dim StrtTm
Dim EndTm
Dim rsPrsCsz As DAO.Recordset
Set rsPrsCsz = CurrentDb.OpenRecordset("SELECT WkDt.* FROM WkDt ORDER BY WkDt.IDWO;")
rsPrsCsz.MoveFirst
StrtTm = Now()
Do Until rsPrsCsz.EOF
If Not IsNull(rsPrsCsz![CSZ]) And rsPrsCsz![CSZ] <> "" Then
'varNewCsz = ParseWord("ross coms ca,94939- 1234", -2, , True, True)
varNewCsz = ParseWord(rsPrsCsz![CSZ], -2, , True, True)
'Calculate length of each csz component
intNumComp = UBound(varNewCsz)
i = 0
Do Until i = intNumComp + 1
varLenCsz(i) = Len(varNewCsz(i))
i = i + 1
Loop
If intNumComp > 0 Then
'If last 2 csz words are of length 2 and 5: check for legit state and 5 numbers
If varLenCsz(intNumComp) = 5 And varLenCsz(intNumComp - 1) = 2 Then
If varNewCsz(intNumComp) Like "#####" Then
'Debug.Print varNewCsz(intNumComp)
'If Not IsNull(DLookup("[statename]", "xstateabbrvs", "[stateabbrv] = '" & varNewCsz(intNumComp - 1) & "'")) Then
'Debug.Print varNewCsz(intNumComp - 1)
rsPrsCsz.Edit
rsPrsCsz!ZIP = varNewCsz(intNumComp)
rsPrsCsz!ST = varNewCsz(intNumComp - 1)
i = 0
For i = 0 To intNumComp - 2
rsPrsCsz!CITY = rsPrsCsz!CITY & " " & varNewCsz(i)
rsPrsCsz!CITY = Trim(rsPrsCsz!CITY)
Next i
rsPrsCsz.Update
GoTo nextCsz
'Else
'rsPrsCsz.Edit
'rsPrsCsz!FCOUNTRY = rsPrsCsz!CSZ
'rsPrsCsz.Update
'GoTo nextCsz
'End If
Else
rsPrsCsz.Edit
rsPrsCsz!FCOUNTRY = rsPrsCsz!CSZ
rsPrsCsz.Update
GoTo nextCsz
End If
End If
'If last 3 csz words are of length 2, 5, and 4: check for legit state and 5 numbers and 4 numbers
If intNumComp > 1 Then
If varLenCsz(intNumComp) = 4 And varLenCsz(intNumComp - 1) = 5 And varLenCsz(intNumComp - 2) = 2 Then
If varNewCsz(intNumComp) Like "####" And varNewCsz(intNumComp - 1) Like "#####" Then
'Debug.Print varNewCsz(intNumComp)
'If Not IsNull(DLookup("[statename]", "xstateabbrvs", "[stateabbrv] = '" & varNewCsz(intNumComp - 2) & "'")) Then
'Debug.Print varNewCsz(intNumComp - 2)
rsPrsCsz.Edit
rsPrsCsz!ZIP4 = varNewCsz(intNumComp)
rsPrsCsz!ZIP = varNewCsz(intNumComp - 1)
rsPrsCsz!ST = varNewCsz(intNumComp - 2)
i = 0
For i = 0 To intNumComp - 3
rsPrsCsz!CITY = rsPrsCsz!CITY & " " & varNewCsz(i)
rsPrsCsz!CITY = Trim(rsPrsCsz!CITY)
Next i
rsPrsCsz.Update
GoTo nextCsz
'Else
'rsPrsCsz.Edit
'rsPrsCsz!FCOUNTRY = rsPrsCsz!CSZ
'rsPrsCsz.Update
'GoTo nextCsz
'End If
Else
rsPrsCsz.Edit
rsPrsCsz!FCOUNTRY = rsPrsCsz!CSZ
rsPrsCsz.Update
GoTo nextCsz
End If
End If
End If
If intNumComp > 0 Then
'If last 2 csz words are of length 2 and 9: check for legit state and 9 numbers
If varLenCsz(intNumComp) = 9 And varLenCsz(intNumComp - 1) = 2 Then
If varNewCsz(intNumComp) Like "#########" Then
'Debug.Print varNewCsz(intNumComp)
'If Not IsNull(DLookup("[statename]", "xstateabbrvs", "[stateabbrv] = '" & varNewCsz(intNumComp - 1) & "'")) Then
'Debug.Print varNewCsz(intNumComp - 1)
rsPrsCsz.Edit
rsPrsCsz!ZIP4 = Right(varNewCsz(intNumComp), 4)
rsPrsCsz!ZIP = Left(varNewCsz(intNumComp), 5)
rsPrsCsz!ST = varNewCsz(intNumComp - 1)
i = 0
For i = 0 To intNumComp - 2
rsPrsCsz!CITY = rsPrsCsz!CITY & " " & varNewCsz(i)
rsPrsCsz!CITY = Trim(rsPrsCsz!CITY)
Next i
rsPrsCsz.Update
GoTo nextCsz
'Else
'rsPrsCsz.Edit
'rsPrsCsz!FCOUNTRY = rsPrsCsz!CSZ
'rsPrsCsz.Update
'GoTo nextCsz
'End If
Else
rsPrsCsz.Edit
rsPrsCsz!FCOUNTRY = rsPrsCsz!CSZ
rsPrsCsz.Update
GoTo nextCsz
End If
End If
End If
'If last word of csz are of length 2: check for legit state
If varLenCsz(intNumComp) = 2 Then
'If Not IsNull(DLookup("[statename]", "xstateabbrvs", "[stateabbrv] = '" & varNewCsz(intNumComp) & "'")) Then
'Debug.Print varNewCsz(intNumComp)
rsPrsCsz.Edit
rsPrsCsz!ST = varNewCsz(intNumComp)
i = 0
For i = 0 To intNumComp - 1
rsPrsCsz!CITY = rsPrsCsz!CITY & " " & varNewCsz(i)
rsPrsCsz!CITY = Trim(rsPrsCsz!CITY)
Next i
rsPrsCsz.Update
GoTo nextCsz
' Else
'
' rsPrsCsz.Edit
' rsPrsCsz!FCOUNTRY = rsPrsCsz!CSZ
' rsPrsCsz.Update
' GoTo nextCsz
'End If
End If
End If
rsPrsCsz.Edit
rsPrsCsz!FCOUNTRY = rsPrsCsz!CSZ
rsPrsCsz.Update
nextCsz:
End If
rsPrsCsz.MoveNext
Loop
EndTm = Now()
Debug.Print StrtTm & " To " & EndTm
Exit_cmdParse_Click:
Exit Sub
Err_cmdParse_Click:
MsgBox Err.Description
Resume Exit_cmdParse_Click
End Sub
Function ParseWord(varPhrase As Variant, ByVal iWordNum As Integer, Optional strDelimiter As String = " ", _
Optional bRemoveLeadingDelimiters As Boolean, Optional bIgnoreDoubleDelimiters As Boolean) As Variant
On Error GoTo Err_Handler
'Purpose: Return the iWordNum-th word from a phrase.
'Return: The word, or Null if not found.
'Arguments: varPhrase = the phrase to search.
' iWordNum = 1 for first word, 2 for second, ...
' Negative values for words form the right: -1 = last word; -2 = second last word, ...
' (Entire phrase returned if iWordNum is zero.)
' strDelimiter = the separator between words. Defaults to a space.
' bRemoveLeadingDelimiters: If True, leading delimiters are stripped.
' Otherwise the first word is returned as null.
' bIgnoreDoubleDelimiters: If true, double-spaces are treated as one space.
' Otherwise the word between spaces is returned as null.
'Author: Allen Browne.
June 2006.
Dim varArray As Variant 'The phrase is parsed into a variant array.
Dim strPhrase As String 'varPhrase converted to a string.
Dim strResult As String 'The result to be returned.
Dim lngLen As Long 'Length of the string.
Dim lngLenDelimiter As Long 'Length of the delimiter.
Dim bCancel As Boolean 'Flag to cancel this operation.
'Const CHARS = ".!?,;:""'()[]{}#"
'Const CHARS = ".!?,;:""'()[]{}#-"
Const CHARS = ",-."
Dim intIndex As Integer
'*************************************
'Validate the arguments
'*************************************
'Cancel if the phrase (a variant) is error, null, or a zero-length string.
If IsError(varPhrase) Then
bCancel = True
Else
strPhrase = Nz(varPhrase, vbNullString)
If strPhrase = vbNullString Then
bCancel = True
End If
End If
' 'If word number is zero, return the whole thing and quit processing.
' If iWordNum = 0 And Not bCancel Then
' strResult = strPhrase
' bCancel = True
' End If
' 'Delimiter cannot be zero-length.
' If Not bCancel Then
' lngLenDelimiter = Len(strDelimiter)
' If lngLenDelimiter = 0& Then
' bCancel = True
' End If
' End If
'*************************************
'Process the string
'*************************************
If Not bCancel Then
strPhrase = varPhrase
'Remove leading delimiters?
' If bRemoveLeadingDelimiters Then
' strPhrase = Nz(varPhrase, vbNullString)
' Do While Left$(strPhrase, lngLenDelimiter) = strDelimiter
' strPhrase = Mid(strPhrase, lngLenDelimiter + 1&)
' Loop
' End If
'Remove Chars
For intIndex = 1 To Len(CHARS)
strPhrase = Trim(Replace(strPhrase, _
Mid(CHARS, intIndex, 1), " "))
Next intIndex
'Ignore doubled-up delimiters?
If bIgnoreDoubleDelimiters Then
Do
lngLen = Len(strPhrase)
strPhrase = Replace(strPhrase, strDelimiter & strDelimiter, strDelimiter)
Loop Until Len(strPhrase) = lngLen
End If
'Cancel if there's no phrase left to work with
' If Len(strPhrase) = 0& Then
' bCancel = True
' End If
End If
'*************************************
'Parse the word from the string.
'*************************************
If Not bCancel Then
' varArray = Split(strPhrase)
ParseWord = Split(strPhrase)
' If UBound(varArray) >= 0 Then
' If iWordNum > 0 Then 'Positive: count words from the left.
' iWordNum = iWordNum - 1 'Adjust for zero-based array.
' If iWordNum <= UBound(varArray) Then
' strResult = varArray(iWordNum)
' End If
' Else 'Negative: count words from the right.
' iWordNum = UBound(varArray) + iWordNum + 1
' If iWordNum >= 0 Then
' strResult = varArray(iWordNum)
' End If
' End If
' End If
End If
'*************************************
'Return the result, or a null if it is a zero-length string.
'*************************************
' If strResult <> vbNullString Then
' ParseWord = strResult
' Else
' ParseWord = Null
' End If
'Added to replace with entire array
'ParseWord = varArray
Exit_Handler:
Exit Function
Err_Handler:
'Call LogError(Err.Number, Err.Description, "ParseWord()")
Resume Exit_Handler
End Function
_____________________________________
There is no rule more invariable than that we are paid for our suspicions by finding out what we expected.
Henry David Thoreau