D
Damian Carrillo
The following code is part of a function I wrote to create import
strings for the generic importer of CMS.net in spring 2005. The same
version of Excel has been running since fall 2005. I last updated the
code in September 2007. The code has not changed since, but starting
in October 2007, my users started reporting an error specific to this
function.
If the vendor does not have date information available, they provide
an entry of 00/00/00 in the DepDate field. Previously the code would
interpret this correctly and function as expected. But now the code
fails of an entry of 00/00/00 appears and I'm not sure why. Theories
abound as to what patch or DMS change or default settings update could
have caused this to happen. I also can't rule out that my updates
somehow screwed it up.
What I need is one of two things: I need to figure out if the last
change inadvertently caused code elsewhere to fail, or; I need a way
to work around this spontaneous failure programatically, as the
current workaround is to force the user to find these entries and
change them to equal the InvDate field before they can even use this
formula.
....
Function AnalyzeTravelBill(Namefield, PNR, DepDate, Amount, UDID1,
Optional InvDate, Optional Destination, Optional Airline)
'Checks each critical field of the travel bill for basic congruity
of data formatting.
'Error Correction is cumulative; When a row's error message is
resolved,
'any lesser errors will be noted next. Only after all errors are
cleared will the
'export string be displayed for transfer to the CMS generic
importer.
'Created by Damian Carrillo. Special thanks to John Walkenbach
for the ingenious ExtractElement function, and to David McRitchie for
his massive and inspirational Excel VBA site.
Dim Entry As String
Dim Result As String
Dim OfficeElement As Variant 'Holds the extracted Office ID
Dim DepartmentElement As Variant 'Holds the extracted Department
ID
Dim EmployeeElement As Variant ' Holds the extracted Employee ID
Dim ClientElement As Variant 'Holds the extracted Client Number
Dim MatterElement As Variant ' Holds the extracted Matter Number
Dim AccountElement As Variant ' Holds the extracted G/L Account
Dim AirlineElement As Variant 'Added 9/21/2007 Holds the Airline
Name or Service Fee Code
Dim DateCheck As String 'Holds DepDate or InvDate information
Dim MonthCheck As String 'Holds Month Information
Dim DayCheck As String 'Holds Day Information
Dim YearCheck As String 'Holds Year information
Let Result = ""
Select Case Len(Namefield)
Case 22 To 23
Let Entry = "CM" 'This means the entry is a Client-Matter
Charge
Let OfficeElement = ExtractElement(Namefield, 1, "-")
Let DepartmentElement = ExtractElement(Namefield, 2, "-")
Let EmployeeElement = ExtractElement(Namefield, 3, "-")
Let ClientElement = ExtractElement(Namefield, 4, "-")
Let MatterElement = ExtractElement(Namefield, 5, "-")
Let AirlineElement = ExtractElement(Airline, 1, "-")
'Added 9/21/2007
Let AccountElement = ""
If IsNumeric(OfficeElement) = False _
Or OfficeElement = "" _
Or OfficeElement = "00" _
Or OfficeElement = "XX" Then
Let Result = "OfficeID Error"
ElseIf IsNumeric(DepartmentElement) = False _
Or DepartmentElement = "" _
Or DepartmentElement = "0000" _
Or DepartmentElement = "000" _
Or DepartmentElement = "XXX" Then
Let Result = "DeptID Error"
ElseIf IsNumeric(EmployeeElement) = False _
Or EmployeeElement = "" _
Or EmployeeElement = "0000" _
Or EmployeeElement = "00000" _
Or EmployeeElement = "XXXXX" Then
Let Result = "EmpID Error"
ElseIf IsNumeric(ClientElement) = False _
Or ClientElement = "" _
Or ClientElement = "00000" _
Or ClientElement = "XXXXX" Then
Let Result = "Client Error"
ElseIf IsNumeric(MatterElement) = False _
And MatterElement = "" _
Or MatterElement = "XXXX" Then
Let Result = "Matter Error"
Else: End If
'''''''''''''''''''''''''''''''''''''''''''''''''
'9/20/2007 - Inserted code to check for an client
number that requires special handling
'A good example is *****, since they can't be charged
fees anymore.
Dim ClientRowCounter As Integer, ClientCellValue As
String
For ClientRowCounter = 40 To 80
With Workbooks("AirTravelBill
Assistant.xls").Worksheets(1).Range("D" & ClientRowCounter)
ClientCellValue = .Value
If ClientElement = ClientCellValue Then
'If additional special client criteria
besides Service Fees
'become an issue additional special client
conditions can
'be set within this IF statement as with
the REM'ed out
'lines below.
If AirlineElement = "AGNT FEE" Then
Let Result = "Illegal Service Fee"
Exit For
'ElseIf
' Let Result = "Special Client"
' Exit For
End If
End If
End With
Next ClientRowCounter
''''''''''''''''''''''''''''''''''''''''''''''''
Case 19 To 20
Let Entry = "GL" 'This means the entry is a General Ledger
Allocation
Let OfficeElement = ExtractElement(Namefield, 1, "-")
Let AccountElement = ExtractElement(Namefield, 2, "-")
Let DepartmentElement = ExtractElement(Namefield, 3, "-")
Let EmployeeElement = ExtractElement(Namefield, 4, "-")
Let ClientElement = ""
Let MatterElement = ""
Let AirlineElement = "" 'Added 9/21/2007
If IsNumeric(OfficeElement) = False _
Or OfficeElement = "" _
Or OfficeElement = "00" Then
Let Result = "OfficeID Error"
ElseIf IsNumeric(AccountElement) = False _
Or AccountElement = "" _
Or AccountElement = "0000000" Then
Let Result = "G/L Error"
ElseIf IsNumeric(DepartmentElement) = False _
Or DepartmentElement = "" _
Or DepartmentElement = "0000" _
Or DepartmentElement = "000" Then
Let Result = "Dept/PG Error"
ElseIf IsNumeric(EmployeeElement) = False _
Or EmployeeElement = "" _
Or EmployeeElement = "0000" _
Or EmployeeElement = "00000" Then
Let Result = "EmpID Error"
'''''''''''''''''''''''''''''''''''''''''''''''''
'Inserted code to check for an excluded
account number that doesn't require
'A specific employee number to import into CMS
Dim RowCounter As Integer, CellValue As String
For RowCounter = 40 To 80
With Workbooks("AirTravelBill
Assistant.xls").Worksheets(1).Range("F" & RowCounter)
CellValue = .Value
If AccountElement = CellValue Then
Let Result = ""
Exit For
End If
End With
Next RowCounter
''''''''''''''''''''''''''''''''''''''''''''''''
Else: End If
Case Else
Let Entry = "ERR" 'This means the entry isn't in the
standard format or has a child matter
'Let Result = "Namefield Error"
End Select
Let DateCheck = Application.WorksheetFunction.Text(DepDate, "YYYY-
MM-DD")
Let YearCheck = Left(DateCheck, 4)
Let MonthCheck = Mid(DateCheck, 6, 2)
Let DayCheck = Right(DateCheck, 2)
If Len(PNR) <> 6 Then 'Evaluate PNR length
Let Result = "PNR Error"
ElseIf Amount = "" Then 'Evaluate Amount for credit
Let Result = "No Amount"
ElseIf UDID1 <> "" Then 'Evaluate UDID1 for special
instructions
Let Result = "Custom UDID"
ElseIf IsMissing(Destination) = False And Destination = ""
Then 'Check for destination city
Let Result = "Destination Missing"
''''''''''''''''''''''''''''''''''''''''
'Code for handling Date checking if departure data is missing
or invalid.
ElseIf Len(DepDate) < 8 Then 'Added 9/21/2007 to check
future date
Let Result = "Invalid Date Format" 'Added 9/21/2007 to
check future date
ElseIf DateValue(DepDate) > Now Then 'Added 9/20/2007
to check future date
Let Result = "Future Date" 'Added 9/20/2007
to check future date
ElseIf MonthCheck = "00" Or DayCheck = "00" Or YearCheck =
"00" Or DepDate = "" Then 'Evaluate DepDate presence and validity
Let Result = "DepDate Error"
If IsMissing(InvDate) = False And DepDate = "" Then
Let Result = "Use InvDate"
End If
''''''''''''''''''''''''''''''''''''''
ElseIf Result = "" Then 'Generate Record Key for all valid
records.
Let Result = "||" & PNR & "||" &
Application.WorksheetFunction.Text(DepDate, "YYYY-MM-DD") & "||" &
Namefield
Else: End If
Let AnalyzeTravelBill = Result
End Function
strings for the generic importer of CMS.net in spring 2005. The same
version of Excel has been running since fall 2005. I last updated the
code in September 2007. The code has not changed since, but starting
in October 2007, my users started reporting an error specific to this
function.
If the vendor does not have date information available, they provide
an entry of 00/00/00 in the DepDate field. Previously the code would
interpret this correctly and function as expected. But now the code
fails of an entry of 00/00/00 appears and I'm not sure why. Theories
abound as to what patch or DMS change or default settings update could
have caused this to happen. I also can't rule out that my updates
somehow screwed it up.
What I need is one of two things: I need to figure out if the last
change inadvertently caused code elsewhere to fail, or; I need a way
to work around this spontaneous failure programatically, as the
current workaround is to force the user to find these entries and
change them to equal the InvDate field before they can even use this
formula.
....
Function AnalyzeTravelBill(Namefield, PNR, DepDate, Amount, UDID1,
Optional InvDate, Optional Destination, Optional Airline)
'Checks each critical field of the travel bill for basic congruity
of data formatting.
'Error Correction is cumulative; When a row's error message is
resolved,
'any lesser errors will be noted next. Only after all errors are
cleared will the
'export string be displayed for transfer to the CMS generic
importer.
'Created by Damian Carrillo. Special thanks to John Walkenbach
for the ingenious ExtractElement function, and to David McRitchie for
his massive and inspirational Excel VBA site.
Dim Entry As String
Dim Result As String
Dim OfficeElement As Variant 'Holds the extracted Office ID
Dim DepartmentElement As Variant 'Holds the extracted Department
ID
Dim EmployeeElement As Variant ' Holds the extracted Employee ID
Dim ClientElement As Variant 'Holds the extracted Client Number
Dim MatterElement As Variant ' Holds the extracted Matter Number
Dim AccountElement As Variant ' Holds the extracted G/L Account
Dim AirlineElement As Variant 'Added 9/21/2007 Holds the Airline
Name or Service Fee Code
Dim DateCheck As String 'Holds DepDate or InvDate information
Dim MonthCheck As String 'Holds Month Information
Dim DayCheck As String 'Holds Day Information
Dim YearCheck As String 'Holds Year information
Let Result = ""
Select Case Len(Namefield)
Case 22 To 23
Let Entry = "CM" 'This means the entry is a Client-Matter
Charge
Let OfficeElement = ExtractElement(Namefield, 1, "-")
Let DepartmentElement = ExtractElement(Namefield, 2, "-")
Let EmployeeElement = ExtractElement(Namefield, 3, "-")
Let ClientElement = ExtractElement(Namefield, 4, "-")
Let MatterElement = ExtractElement(Namefield, 5, "-")
Let AirlineElement = ExtractElement(Airline, 1, "-")
'Added 9/21/2007
Let AccountElement = ""
If IsNumeric(OfficeElement) = False _
Or OfficeElement = "" _
Or OfficeElement = "00" _
Or OfficeElement = "XX" Then
Let Result = "OfficeID Error"
ElseIf IsNumeric(DepartmentElement) = False _
Or DepartmentElement = "" _
Or DepartmentElement = "0000" _
Or DepartmentElement = "000" _
Or DepartmentElement = "XXX" Then
Let Result = "DeptID Error"
ElseIf IsNumeric(EmployeeElement) = False _
Or EmployeeElement = "" _
Or EmployeeElement = "0000" _
Or EmployeeElement = "00000" _
Or EmployeeElement = "XXXXX" Then
Let Result = "EmpID Error"
ElseIf IsNumeric(ClientElement) = False _
Or ClientElement = "" _
Or ClientElement = "00000" _
Or ClientElement = "XXXXX" Then
Let Result = "Client Error"
ElseIf IsNumeric(MatterElement) = False _
And MatterElement = "" _
Or MatterElement = "XXXX" Then
Let Result = "Matter Error"
Else: End If
'''''''''''''''''''''''''''''''''''''''''''''''''
'9/20/2007 - Inserted code to check for an client
number that requires special handling
'A good example is *****, since they can't be charged
fees anymore.
Dim ClientRowCounter As Integer, ClientCellValue As
String
For ClientRowCounter = 40 To 80
With Workbooks("AirTravelBill
Assistant.xls").Worksheets(1).Range("D" & ClientRowCounter)
ClientCellValue = .Value
If ClientElement = ClientCellValue Then
'If additional special client criteria
besides Service Fees
'become an issue additional special client
conditions can
'be set within this IF statement as with
the REM'ed out
'lines below.
If AirlineElement = "AGNT FEE" Then
Let Result = "Illegal Service Fee"
Exit For
'ElseIf
' Let Result = "Special Client"
' Exit For
End If
End If
End With
Next ClientRowCounter
''''''''''''''''''''''''''''''''''''''''''''''''
Case 19 To 20
Let Entry = "GL" 'This means the entry is a General Ledger
Allocation
Let OfficeElement = ExtractElement(Namefield, 1, "-")
Let AccountElement = ExtractElement(Namefield, 2, "-")
Let DepartmentElement = ExtractElement(Namefield, 3, "-")
Let EmployeeElement = ExtractElement(Namefield, 4, "-")
Let ClientElement = ""
Let MatterElement = ""
Let AirlineElement = "" 'Added 9/21/2007
If IsNumeric(OfficeElement) = False _
Or OfficeElement = "" _
Or OfficeElement = "00" Then
Let Result = "OfficeID Error"
ElseIf IsNumeric(AccountElement) = False _
Or AccountElement = "" _
Or AccountElement = "0000000" Then
Let Result = "G/L Error"
ElseIf IsNumeric(DepartmentElement) = False _
Or DepartmentElement = "" _
Or DepartmentElement = "0000" _
Or DepartmentElement = "000" Then
Let Result = "Dept/PG Error"
ElseIf IsNumeric(EmployeeElement) = False _
Or EmployeeElement = "" _
Or EmployeeElement = "0000" _
Or EmployeeElement = "00000" Then
Let Result = "EmpID Error"
'''''''''''''''''''''''''''''''''''''''''''''''''
'Inserted code to check for an excluded
account number that doesn't require
'A specific employee number to import into CMS
Dim RowCounter As Integer, CellValue As String
For RowCounter = 40 To 80
With Workbooks("AirTravelBill
Assistant.xls").Worksheets(1).Range("F" & RowCounter)
CellValue = .Value
If AccountElement = CellValue Then
Let Result = ""
Exit For
End If
End With
Next RowCounter
''''''''''''''''''''''''''''''''''''''''''''''''
Else: End If
Case Else
Let Entry = "ERR" 'This means the entry isn't in the
standard format or has a child matter
'Let Result = "Namefield Error"
End Select
Let DateCheck = Application.WorksheetFunction.Text(DepDate, "YYYY-
MM-DD")
Let YearCheck = Left(DateCheck, 4)
Let MonthCheck = Mid(DateCheck, 6, 2)
Let DayCheck = Right(DateCheck, 2)
If Len(PNR) <> 6 Then 'Evaluate PNR length
Let Result = "PNR Error"
ElseIf Amount = "" Then 'Evaluate Amount for credit
Let Result = "No Amount"
ElseIf UDID1 <> "" Then 'Evaluate UDID1 for special
instructions
Let Result = "Custom UDID"
ElseIf IsMissing(Destination) = False And Destination = ""
Then 'Check for destination city
Let Result = "Destination Missing"
''''''''''''''''''''''''''''''''''''''''
'Code for handling Date checking if departure data is missing
or invalid.
ElseIf Len(DepDate) < 8 Then 'Added 9/21/2007 to check
future date
Let Result = "Invalid Date Format" 'Added 9/21/2007 to
check future date
ElseIf DateValue(DepDate) > Now Then 'Added 9/20/2007
to check future date
Let Result = "Future Date" 'Added 9/20/2007
to check future date
ElseIf MonthCheck = "00" Or DayCheck = "00" Or YearCheck =
"00" Or DepDate = "" Then 'Evaluate DepDate presence and validity
Let Result = "DepDate Error"
If IsMissing(InvDate) = False And DepDate = "" Then
Let Result = "Use InvDate"
End If
''''''''''''''''''''''''''''''''''''''
ElseIf Result = "" Then 'Generate Record Key for all valid
records.
Let Result = "||" & PNR & "||" &
Application.WorksheetFunction.Text(DepDate, "YYYY-MM-DD") & "||" &
Namefield
Else: End If
Let AnalyzeTravelBill = Result
End Function