I am having a problem with the below code. The process looks for a price/m for a grade if a match is found then it is used. If no price is found it prompts user to enter a price/m. It is suppose to loop for each missing price/m that it finds. What it does is prompt user for missing price/m for each multiple times and only uses the first value prompted and leaves the rest with a zero price/m. Not sure what is wrong with it. Any help would be appreciated.
Public Function fcnPromptPerMPrice(strGrade As String, Optional varPrice As Variant) As Currency
On Error GoTo Err_fcnPromptPerMPrice
'If the loading (input) price per m for a specific grade is missing,
'this routine prompts the user for a grade to use for the KD subform of
'the Kiln Analysis report.
Dim strPrompt As String
Dim strResponse As String
Dim i As Integer
Static aPrices() As typPrice
Static intPass As Integer 'Tracks of the number of times this routine was accessed
'Assign an initial size to the array
If intPass = 0 Then
ReDim aPrices(0)
End If
intPass = intPass + 1
'Reset all values to zero and exit
If strGrade = "ResetAll" Then
Erase aPrices
intPass = 0
Exit Function
End If
'If the calling query passed in a valid number, round it off, convert it to currency
'return its value, and exit the function
If (Not IsMissing(varPrice)) And (IsNumeric(varPrice)) Then
fcnPromptPerMPrice = CCur(AI_fcnRound(varPrice, 2))
Exit Function
End If
'Check to see if a value has already been entered for this grade. If so,
'use it and exit the function
For i = 0 To UBound(aPrices)
If aPrices(i).GradeName = strGrade Then
fcnPromptPerMPrice = aPrices(i).Price
Exit Function
End If
Next i
strPrompt = "An average price per thousand can not be calculated for " _
& strGrade & " grade lumber." & Chr(13) & Chr(10) & Chr(13) & Chr(10) _
& "Please enter a price to use."
StartOver:
'Prompt the user for a value to use for this grade
strResponse = Trim(InputBox(strPrompt, APP_NAME))
'User hit CANCEL, return zero
If strResponse = "" Then
fcnPromptPerMPrice = 0
Exit Function
End If
'Verify that the user entered a number, otherwise, warn the user
'and start over
If Not IsNumeric(strResponse) Then
MsgBox "Invalid price", vbOKOnly + vbExclamation, APP_NAME
GoTo StartOver
End If
'Use the value that the user input
fcnPromptPerMPrice = CCur(strResponse)
'Add the new value to the static array, so that the next time
'this routine is called, the user won't be prompted again for a price for this grade.
'If it is empty, fill-in the first array element
If aPrices(0).GradeName = "" Then
aPrices(0).GradeName = strGrade
aPrices(0).Price = fcnPromptPerMPrice
Else
'If the array has been accessed previously, add a new array element and
'fill-in the grade and price
ReDim Preserve aPrices(UBound(aPrices))
With aPrices(UBound(aPrices) - 1)
.GradeName = strGrade
.Price = fcnPromptPerMPrice
End With
End If
Exit_fcnPromptPerMPrice:
Exit Function
Err_fcnPromptPerMPrice:
MsgBox Err.Description, vbOKOnly, APP_NAME
Resume Exit_fcnPromptPerMPrice
Resume
End Function