Auto calculate a text box when other boxes change values

[anthgav]

Hi

I have an Access application that manages product locations.
I'm trying to enhance the features on one of the forms.


The form is called 'frmProduct' and it has a sub form called 'frmProduct subform'.

On the 'frmProduct subform' I have a text box called 'masterBinWidthMM'. I'm trying to make this box auto calculate the selected bin's width.
To achieve this it needs to calculate the size when there are changes to 'widthMM' text box, 'rows' text box and 'masterBinSelectBox' combobox.

I added this VB code to attempt to make it work.

Private Sub masterBinSelectBox_AfterUpdate()
    If DLookup("[calculate_bin_by_product]", "[tblBinType]", "[bin_type] = [masterBinType]") = True Then
        Me.masterBinWidthMM.Value = IIf(Int([rows]) = [rows], [widthMM] * [rows], ([widthMM] * Int([rows])) + [depthMM])
    Else
        Me.masterBinWidthMM.Value = DLookup("[width_mm]", "[tblBinType]", "[bin_type] = [masterBinType]")
    End If
End Sub

Private Sub rows_AfterUpdate()
    If DLookup("[calculate_bin_by_product]", "[tblBinType]", "[bin_type] = [masterBinType]") = True Then
        Me.masterBinWidthMM.Value = IIf(Int([rows]) = [rows], [widthMM] * [rows], ([widthMM] * Int([rows])) + [depthMM])
    Else
        Me.masterBinWidthMM.Value = DLookup("[width_mm]", "[tblBinType]", "[bin_type] = [masterBinType]")
    End If
End Sub

Private Sub widthMM_AfterUpdate()
    If DLookup("[calculate_bin_by_product]", "[tblBinType]", "[bin_type] = [masterBinType]") = True Then
        Me.masterBinWidthMM.Value = IIf(Int([rows]) = [rows], [widthMM] * [rows], ([widthMM] * Int([rows])) + [depthMM])
    Else
        Me.masterBinWidthMM.Value = DLookup("[width_mm]", "[tblBinType]", "[bin_type] = [masterBinType]")
    End If
End Sub

I have a couple of issues.
If the sub form already has an entry in it then changing 'widthMM' text box and 'rows' text box has the desired effect and 'masterBinWidthMM' recalculates.
When I select a product and the sub form is empty I try to add a new sub form entry and I get this message in the image below. This error doesn't happen before I added the code above.


Also the 'masterBinSelectBox' combobox doesn't calculate 'masterBinWidthMM' as expected.

I've attached the application to view.

Can someone assist me with this please?

Thanks

[ranman256]

i'm assuming me.masterBinType is a string...

Private Sub masterBinSelectBox_AfterUpdate()
  CalcIt
End Sub

Private Sub rows_AfterUpdate()
  CalcIt
End Sub

Private Sub widthMM_AfterUpdate()
  CalcIt
End Sub

sub CalcIt()
dim vVal, vParam

If Int(me.rows) = me.rows then 
   vVal =  me.widthMM * me.rows
else
   vVal = me.widthMM * Int(me.rows) + me.depthMM
endif

    vParam = "[bin_type] ='" & me.masterBinType & "'"

    If DLookup("[calculate_bin_by_product]", "[tblBinType]", vParam)  Then
        Me.masterBinWidthMM = vVal
    Else
        Me.masterBinWidthMM = DLookup("[width_mm]", "[tblBinType]", vParam)
    End If
end sub

[Gicu]

I had a quick look at your db and I think you might want to rethink your design. You have some lookup fields in your tables that are causing problems (product in tblProduct uses an non-existing PTZ from tblProductData, Bay, area etc.). As a general rule you don't want lookups in tables, their place is in the form as combo-boxes. Then some of the queries you have (the source for the subform and for the combo-boxes on the subform) probably need to be looked at and edited.

Have a look at the updated file. To avoid the error (caused by the fact that you want to update a bound control) I have added an unbound text box (set to visible=false) to hold the result of the recalculation and I make the bound control -the unbound in the BeforeUpdate of the subform. https://stackoverflow.com/questions/...-in-access-vba

[anthgav]

Thanks for your help guys.

ranman256, I had a play around with your code but I was still getting the same errors as before.

I had a quick look at your db and I think you might want to rethink your design. You have some lookup fields in your tables that are causing problems (product in tblProduct uses an non-existing PTZ from tblProductData, Bay, area etc.). As a general rule you don't want lookups in tables, their place is in the form as combo-boxes. Then some of the queries you have (the source for the subform and for the combo-boxes on the subform) probably need to be looked at and edited.

Have a look at the updated file. To avoid the error (caused by the fact that you want to update a bound control) I have added an unbound text box (set to visible=false) to hold the result of the recalculation and I make the bound control -the unbound in the BeforeUpdate of the subform. https://stackoverflow.com/questions/...-in-access-vba

Gicu, I didn't spot that error in tblProduct, PTZ was the name of the field in a previous version, I've now corrected that. In terms of all the lookup fields I need to understand how I can convert them to the form instead of the table and I shall go away and read up on that one. Please can you elaborate on what you feel is wrong with my queries for the subform please?

After playing around with my form after your changes I've found a couple of issues. Changing the 'width_mm' and 'row' text boxes and then saving updates the database but does not always update the 'bin_width_mm' box on the form so I don't get a visual confirmation it's changed on the form.
When I change an already existing product master bin location and save I get the following error.


After reading the link you provided are you saying I need to use a temporary table for the record source to solve this error for new entries on the subform?

[Gicu]

You can read here about lookup fields:http://access.mvps.org/access/lookupfields.htm There are other post in this forum regarding them. Instead of using lookup fields in the table use a combo-box in the form.

That was the error(the changes you requested...) I was getting when trying to add a new record manually with the query that is behind the subform. I think you need to review the relationships between the tables to see where the problem occurs.

Cheers,
Vlad

[anthgav]

After your advice I've had a read up and a rethink about how to implement this. I've removed the lookup field from the database product field and only have it in the form combo box. I've made the 'Bin Width mm' an unbound text box and update it with VBA. I've written this code instead.

Private Sub recalculateBinSize()
    Dim binID As Integer
    Dim binType As String
    Dim masterBinType As String
    Dim requiredBinWidthByProduct As Long
    Dim requiredBinWidthByBinType As Integer
    Dim updateBinWidthMethod As String
    Dim updateBinWidthByProduct As String
    Dim updateBinWidthByBinType As String
    
    binID = [masterBinSelectBox].[Column](0)
    masterBinType = [masterBinSelectBox].[Column](3)
    updateBinWidthMethod = DLookup("[calculate_bin_by_product]", "[tblBinType]", "[bin_type] = masterBinType")
    requiredBinWidthByProduct = IIf(Int([rows]) = [rows], [widthMM] * [rows], ([widthMM] * Int([rows])) + [depthMM])
    requiredBinWidthByBinType = DLookup("[width_mm]", "[tblBinType]", "[bin_type] = masterBinType")
    updateBinWidthByProduct = "UPDATE tblBin SET [bin_width_mm] ='" & (requiredBinWidthByProduct) & "'WHERE [bin_id] = " & (binID) & ";"
    updateBinWidthByBinType = "UPDATE tblBin SET [bin_width_mm] ='" & (requiredBinWidthByBinType) & "'WHERE [bin_id] = " & (binID) & ";"
    
    If updateBinWidthMethod = -1 Then
        DoCmd.RunSQL updateBinWidthByProduct
        Me.masterBinWidthMM.Value = requiredBinWidthByProduct
    Else
        DoCmd.RunSQL updateBinWidthByBinType
        Me.masterBinWidthMM.Value = requiredBinWidthByBinType
    End If
End Sub


Private Sub masterBinSelectBox_AfterUpdate()
    recalculateBinSize
End Sub
    
Private Sub rows_AfterUpdate()
    recalculateBinSize
End Sub


Private Sub widthMM_AfterUpdate()
    recalculateBinSize
End Sub

So now I update the values directly into the database with SQL instead of trying to update a bound text box. I've almost got it working just how I want it but I have one snag. When the 'Else' part of the code runs

Else
    DoCmd.RunSQL updateBinWidthByBinType
    Me.masterBinWidthMM.Value = requiredBinWidthByBinType
End If

I get this error message after I hit the save button.


This doesn't happen when the 'If' part of the code runs.
Any ideas why this is?

[anthgav]

The issue seems to be with this line.

requiredBinWidthByBinType = DLookup("[width_mm]", "[tblBinType]", "[bin_type] = masterBinType")

If I replace it with...

requiredBinWidthByBinType = 420

...then the code works ok. It seems to be an issue with the DLookup. I'm suspecting it's because I'm calling a DLookup variable from inside an SQL Update statement, is this possible or do I have to find another way of doing it?

[June7]

Concatenate variables.

updateBinWidthMethod = DLookup("[calculate_bin_by_product]", "[tblBinType]", "[bin_type] = " & masterBinType)

requiredBinWidthByBinType = DLookup("[width_mm]", "[tblBinType]", "[bin_type] = " & masterBinType)

If bin_type is a text data type, use apostrophe delimiters: "bin_type='" & masterBinType & "'"

Need a space in front of WHERE in the SQL and the semi-colon is not needed and no parens:

updateBinWidthByProduct = "UPDATE tblBin SET [bin_width_mm] ='" & requiredBinWidthByProduct & "' WHERE [bin_id] = " & (binID)
updateBinWidthByBinType = "UPDATE tblBin SET [bin_width_mm] ='" & requiredBinWidthByBinType & "' WHERE [bin_id] = " & (binID)

If bin_width_mm is a number type field, do not use apostrophe delimiters.

If you want to avoid the warning popups that RunSQL triggers, either use DoCmd.SetWarnings False ... DoCmd.SetWarnings True or use CurrentDb.Execute.

[anthgav]

Thanks for that. This is what my final code looks like, everything works as i want it. I'd be grateful if you could cast your eyes over it to ensure I've done it correctly and perhaps suggest improvements if required.

Option Compare Database
Option Explicit


Public binType As String
Public requiredBinWidthByProduct As Long
Public requiredBinWidthByBinType As Integer
Public updateBinWidthMethod As String


Private Sub Form_Current()
    setBinWidthMmTextBoxValues
End Sub


Private Sub setBinWidthMmTextBoxValues()
    If Not IsNull([masterBinSelectBox]) Then
        binType = Nz([masterBinSelectBox].[Column](3), 0)
        requiredBinWidthByProduct = Nz(IIf(Int([rows]) = [rows], [widthMM] * [rows], ([widthMM] * Int([rows])) + [depthMM]), 0)
        requiredBinWidthByBinType = Nz(DLookup("[width_mm]", "[tblBinType]", "[bin_type] ='" & binType & "'"), 0)
        updateBinWidthMethod = Nz(DLookup("[calculate_bin_by_product]", "[tblBinType]", "[bin_type] ='" & binType & "'"), 1)
        
        If updateBinWidthMethod = -1 Then
            Me.masterBinWidthMM.Value = requiredBinWidthByProduct
        ElseIf updateBinWidthMethod = 0 Then
            Me.masterBinWidthMM.Value = requiredBinWidthByBinType
        End If
        
        If Not IsNull([secondaryBinSelectBox]) Then
            binType = Nz([secondaryBinSelectBox].[Column](3), 0)
            requiredBinWidthByBinType = Nz(DLookup("[width_mm]", "[tblBinType]", "[bin_type] ='" & binType & "'"), 0)
            updateBinWidthMethod = Nz(DLookup("[calculate_bin_by_product]", "[tblBinType]", "[bin_type] ='" & binType & "'"), 1)
            
            If updateBinWidthMethod = -1 Then
                Me.secondaryBinWidthMM.Value = requiredBinWidthByProduct
            ElseIf updateBinWidthMethod = 0 Then
                Me.secondaryBinWidthMM.Value = requiredBinWidthByBinType
            End If
        Else
            Me.secondaryBinWidthMM.Value = ""
        End If
    Else
        Me.masterBinWidthMM.Value = ""
        Me.secondaryBinWidthMM.Value = ""
    End If
End Sub


Private Sub recalculateBinSize()
    If Not IsNull([masterBinSelectBox]) Then
        Dim binID As Integer
        Dim updateBinWidthByProduct As String
        Dim updateBinWidthByBinType As String
        
        binID = Nz([masterBinSelectBox].[Column](1), 0)
        binType = Nz([masterBinSelectBox].[Column](3), 0)
        requiredBinWidthByProduct = Nz(IIf(Int([rows]) = [rows], [widthMM] * [rows], ([widthMM] * Int([rows])) + [depthMM]), 0)
        requiredBinWidthByBinType = Nz(DLookup("[width_mm]", "[tblBinType]", "[bin_type] ='" & binType & "'"), 0)
        updateBinWidthMethod = Nz(DLookup("[calculate_bin_by_product]", "[tblBinType]", "[bin_type] ='" & binType & "'"), 1)
        updateBinWidthByProduct = "UPDATE tblBin SET [bin_width_mm] ='" & (requiredBinWidthByProduct) & "' WHERE [bin_id] = " & (binID)
        updateBinWidthByBinType = "UPDATE tblBin SET [bin_width_mm] ='" & (requiredBinWidthByBinType) & "' WHERE [bin_id] = " & (binID)
        
        If updateBinWidthMethod = -1 Then
            CurrentDb.Execute updateBinWidthByProduct
        ElseIf updateBinWidthMethod = 0 Then
            CurrentDb.Execute updateBinWidthByBinType
        End If
        
        If Not IsNull([secondaryBinSelectBox]) Then
            binID = Nz([secondaryBinSelectBox].[Column](1), 0)
            binType = Nz([secondaryBinSelectBox].[Column](3), 0)
            updateBinWidthMethod = Nz(DLookup("[calculate_bin_by_product]", "[tblBinType]", "[bin_type] ='" & binType & "'"), 1)
            requiredBinWidthByBinType = Nz(DLookup("[width_mm]", "[tblBinType]", "[bin_type] ='" & binType & "'"), 0)
            updateBinWidthByProduct = "UPDATE tblBin SET [bin_width_mm] ='" & (requiredBinWidthByProduct) & "' WHERE [bin_id] = " & (binID)
            updateBinWidthByBinType = "UPDATE tblBin SET [bin_width_mm] ='" & (requiredBinWidthByBinType) & "' WHERE [bin_id] = " & (binID)
            
            If updateBinWidthMethod = -1 Then
                CurrentDb.Execute updateBinWidthByProduct
            ElseIf updateBinWidthMethod = 0 Then
                CurrentDb.Execute updateBinWidthByBinType
            End If
        End If
        setBinWidthMmTextBoxValues
    End If
End Sub


Private Sub depthMM_AfterUpdate()
    recalculateBinSize
End Sub


Private Sub masterBinSelectBox_AfterUpdate()
    recalculateBinSize
End Sub


Private Sub secondaryBinSelectBox_AfterUpdate()
    recalculateBinSize
End Sub
    
Private Sub rows_AfterUpdate()
    recalculateBinSize
End Sub


Private Sub widthMM_AfterUpdate()
    recalculateBinSize
End Sub