User InputBoxes If DLOOKUP Fails to Return Values Problem

[Constantine AI]

Hi i am trying to get User input if data does not exist within a DLOOKUP table. I have gotten it to work for one record but not multiple, i have tried to incorporate my code into a loop procedure but i have failed. Could anyone give me any advice?

    Dim db As Database
    Dim rst As Recordset
    Dim rst2 As Recordset
    Dim strSQL As String
    Dim Widthval As Integer
    Dim Depthval As Integer
    Dim Heightval As Integer
    Dim IntWithGrain As Integer
    Dim IntAcrossGrain As Integer
    Dim StrBoth As String
 
    DoCmd.SetWarnings False
 
    Set db = CurrentDb()
    Set rst = db.OpenRecordset("SELECT * FROM preordlin WHERE SubStkID > 0")
 
    'Lookup tables for values and place in form
 
    Do
        rst.Edit
        'If IsNull(rst![WithGrain]) Then
            'IntWithGrain = InputBox("Please Enter the WithGrain Value", "Criteria Required")
            'rst![WithGrain] = IntWithGrain
            'Else
        rst!WithGrain = DLookup("WithGrain", "cmpbommas", "[SubStkID] = " & rst!SubStkID & "And [CmpID] = " & rst!StkID)
                'If IsNull(rst![AcrossGrain]) Then
                    'IntAcrossGrain = InputBox("Please Enter the AcrossGrain Value", "Criteria Required")
                    'rst![AcrossGrain] = IntAcrossGrain
                    'Else
        rst!AcrossGrain = DLookup("AcrossGrain", "cmpbommas", "[SubStkID] = " & rst!SubStkID & "And [CmpID] = " & rst!StkID)
                        'If IsNull(rst![Edged]) Then
                            'strEdged = InputBox("Please Enter the Edged Value", "Criteria Required")
                            'rst![Edged] = strEdged
                            'Else
        rst!Edged = DLookup("Edged", "cmpbommas", "[SubStkID] = " & rst!SubStkID & "And [CmpID] = " & rst!StkID)
                        'End If
                'End If
        'End If
        rst.update
        rst.MoveNext
    Loop Until rst.EOF
    rst.Close
    Me.Requery
    Set rst = Nothing
 
    Set rst = db.OpenRecordset("SELECT * FROM preordlin WHERE WithGrain <> Null and AcrossGrain <> Null")
 
    'Update the Paramters Width, Depth and Height with the New Inputted Values
 
    Do
        rst.Edit
 
        Set rst2 = db.OpenRecordset("SELECT * FROM parmas WHERE ParameterShortDesc = 'Width'")
        [Widthval] = rst!Width
        db.Execute ("UPDATE parmas SET [Value] = " & [Widthval] & " WHERE ParameterShortDesc = 'Width';")
 
        Set rst2 = db.OpenRecordset("SELECT * FROM parmas WHERE ParameterShortDesc = 'Depth'")
        [Depthval] = rst!Depth
        db.Execute ("UPDATE parmas SET [Value] = " & [Depthval] & " WHERE ParameterShortDesc = 'Depth';")
 
        Set rst2 = db.OpenRecordset("SELECT * FROM parmas WHERE ParameterShortDesc = 'Height'")
        [Heightval] = rst!Height
        db.Execute ("UPDATE parmas SET [Value] = " & [Heightval] & " WHERE ParameterShortDesc = 'Height';")
 
        rst!WithGrain = fCalcEquation(rst!WithGrain)
        rst!AcrossGrain = fCalcEquation(rst!AcrossGrain)
        rst.update
        rst.MoveNext
 
    Loop Until rst.EOF
    rst.Close
 
    'Set Paramter Values back to Default after the Equation Event
 
        Set rst2 = db.OpenRecordset("SELECT * FROM parmas WHERE ParameterShortDesc = 'Width'")
        db.Execute ("UPDATE parmas SET [Value] = 500 WHERE ParameterShortDesc = 'Width';")
 
        Set rst2 = db.OpenRecordset("SELECT * FROM parmas WHERE ParameterShortDesc = 'Depth'")
        db.Execute ("UPDATE parmas SET [Value] = 300 WHERE ParameterShortDesc = 'Depth';")
 
        Set rst2 = db.OpenRecordset("SELECT * FROM parmas WHERE ParameterShortDesc = 'Height'")
        db.Execute ("UPDATE parmas SET [Value] = 130 WHERE ParameterShortDesc = 'Height';")
 
    Me.Requery
    Set rst = Nothing
 
    DoCmd.SetWarnings True
 
    'Enable the Specific Buttons to Progress, Disabling the Others
 
    cmdCheckStock.Enabled = False
    cmdAddStock.Enabled = False
    cmdAssignDetails.Enabled = False
    cmdUpdateInformation.Enabled = False
    cmdcalcgrainmeasures.Enabled = False
    cmdImportintoOrderline.Enabled = True
 
Exit_cmdCalcGrainMeasures_Click:
    Exit Sub
 
Err_cmdCalcGrainMeasures_Click:
 
    Set db = CurrentDb()
    Set rst = db.OpenRecordset("SELECT * FROM preordlin WHERE SubStkID > 0")
 
    'If the DLOOKUP Fails to input values then ask the User to Input the values themselves
 
    Do
        rst.Edit
        If IsNull(WithGrain) Then
            IntWithGrain = InputBox("Please Enter the WithGrain Value", "Criteria Required")
            [WithGrain] = IntWithGrain
            If IsNull(AcrossGrain) Then
                IntAcrossGrain = InputBox("Please Enter the AcrossGrain Value", "Criteria Required")
                [AcrossGrain] = IntAcrossGrain
                If IsNull(Edged) Then
                    strEdged = InputBox("Please Enter the Edged Value", "Criteria Required")
                    [Edged] = strEdged
                End If
            End If
        End If
        rst.update
        rst.MoveNext
    Loop Until rst.EOF
    rst.Close
    Me.Requery
 
    cmdCheckStock.Enabled = False
    cmdAddStock.Enabled = False
    cmdAssignDetails.Enabled = False
    cmdUpdateInformation.Enabled = False
    cmdcalcgrainmeasures.Enabled = False
    cmdImportintoOrderline.Enabled = True
 
    Resume Exit_cmdCalcGrainMeasures_Click

This code here within the Err_cmdCalcGrainMeasures works fine without a loop however after trying to incorporate a loop within, i failed!

This is the simple code alone that works for one record only;

        If IsNull(WithGrain) Then
            IntWithGrain = InputBox("Please Enter the WithGrain Value", "Criteria Required")
            [WithGrain] = IntWithGrain
            If IsNull(AcrossGrain) Then
                IntAcrossGrain = InputBox("Please Enter the AcrossGrain Value", "Criteria Required")
                [AcrossGrain] = IntAcrossGrain
                If IsNull(Edged) Then
                    strEdged = InputBox("Please Enter the Edged Value", "Criteria Required")
                    [Edged] = strEdged
                End If
            End If
        End If

Any help would be greatly appreciated! Thanks in advance.


Chris

[NeoPa]

Chris,

You really need to look at our Posting Guidelines. This sort of dumping 150 lines of code is not how it works (It's not considerate). Nor does it help you get a solution to your problem.

As for your fundamental question, I suspect you need to read the help section for DLookup() (and most of the Domain Aggregate functions really), where it explains that calls which find no results return the Null value.

Simple use of the Nz() function allows you to handle this logically.