If/then cascade effect for inventory spreadsheet.

Holmes89

New Member
Joined
May 8, 2023
Messages
21
Office Version
  1. 2016
Platform
  1. Windows
Looking for an if/then formula that includes a cascade effect. For example column A is pallets of beer, it holds 24 cases of 24 beers. Column b is cases (so when you open a pallet you then 24 cases) then column c has individual bottles. Once column C goes into the - (minus) I would like the spread sheet to drop from 24 cases to 23 and the individual bottles and pallet to self adjust.
Fairly new to excel looking to impress my boss 😂
 
And I think I have something for you. The following code should be placed into the sheet module for your inventory sheet.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Declare variables to hold current Starting Inventory and Inventory Removal values
Dim cD As Long, cE As Long, cF As Long, Ind As Long, sixP As Long

'Disable Events to prevent unexpected events from triggering code
Application.EnableEvents = False

'Check to see if values changed within range of H7:I18
If Not Intersect(Target, Range("H7:I18")) Is Nothing And Target.Count = 1 And Target.Value <> 0 Then

'Store current Starting Inventory values
cD = Range("D" & Target.Row).Value 'Column D value (cases)
cE = Range("E" & Target.Row).Value 'Column E value (6 packs)
cF = Range("F" & Target.Row).Value 'Column F value (individuals)

    'Perform cascading calculation based on which column was updated (6-pack(H) or Individual(I))
    Select Case Target.Column
        'Column H calculation (6-pack)
        Case 8 'Column H
            'Store Inventory Removal value
            sixP = Range("H" & Target.Row).Value
            'Do the thing!
            cE = cE - sixP
            If cE < 0 And cD >= WorksheetFunction.RoundUp(Abs((cE * 6) / 24), 0) Then
                cD = cD - WorksheetFunction.RoundUp(Abs((cE * 6) / 24), 0)
                cE = cE + WorksheetFunction.RoundUp(Abs((cE * 6) / 24), 0) * 4
            Else
                cE = cE + (cD * 4)
                cD = cD - cD
                If cE < 0 And cF >= Abs(cE * 6) Then
                    cF = cF - Abs(cE * 6)
                    cE = cE + Abs(cE)
                End If
            End If
               
        'Column I calculation (Individual)
        Case 9 'Column I
            'Store Inventory Removal value
            Ind = Range("I" & Target.Row).Value
            'Do the thing!
            cF = cF - Ind
            If cF < 0 And cE >= WorksheetFunction.RoundUp(Abs(cF / 6), 0) Then
                cE = cE - WorksheetFunction.RoundUp(Abs(cF / 6), 0)
                cF = cF + WorksheetFunction.RoundUp(Abs(cF / 6), 0) * 6
            ElseIf cE < WorksheetFunction.RoundUp(Abs(cF / 6), 0) And (cD * 24) >= Abs(cF) Then
                cD = cD - WorksheetFunction.RoundUp(Abs(cF / 24), 0)
                cE = cE + (WorksheetFunction.RoundUp(Abs(cF / 24), 0) * 24) / 6
                cE = cE - WorksheetFunction.RoundUp(Abs(cF / 6), 0)
                cF = cF + WorksheetFunction.RoundUp(Abs(cF / 6), 0) * 6
            Else
                cF = cF + (cE * 6) + (cD * 24)
                cE = cE - cE
                cD = cD - cD
            End If
    End Select

'Update Starting Inventory values after calculations
Range("D" & Target.Row).Value = cD
Range("E" & Target.Row).Value = cE
Range("F" & Target.Row).Value = cF

End If

'Enable events so the code can work again on next update
Application.EnableEvents = True
End Sub
 
Upvote 0

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
If I take more packs than are available, but there are enough singles to make up to difference, should it continue into singles or just go negative for packs?
I want them to never stay negative if possible
 
Upvote 0
And I think I have something for you. The following code should be placed into the sheet module for your inventory sheet.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Declare variables to hold current Starting Inventory and Inventory Removal values
Dim cD As Long, cE As Long, cF As Long, Ind As Long, sixP As Long

'Disable Events to prevent unexpected events from triggering code
Application.EnableEvents = False

'Check to see if values changed within range of H7:I18
If Not Intersect(Target, Range("H7:I18")) Is Nothing And Target.Count = 1 And Target.Value <> 0 Then

'Store current Starting Inventory values
cD = Range("D" & Target.Row).Value 'Column D value (cases)
cE = Range("E" & Target.Row).Value 'Column E value (6 packs)
cF = Range("F" & Target.Row).Value 'Column F value (individuals)

    'Perform cascading calculation based on which column was updated (6-pack(H) or Individual(I))
    Select Case Target.Column
        'Column H calculation (6-pack)
        Case 8 'Column H
            'Store Inventory Removal value
            sixP = Range("H" & Target.Row).Value
            'Do the thing!
            cE = cE - sixP
            If cE < 0 And cD >= WorksheetFunction.RoundUp(Abs((cE * 6) / 24), 0) Then
                cD = cD - WorksheetFunction.RoundUp(Abs((cE * 6) / 24), 0)
                cE = cE + WorksheetFunction.RoundUp(Abs((cE * 6) / 24), 0) * 4
            Else
                cE = cE + (cD * 4)
                cD = cD - cD
                If cE < 0 And cF >= Abs(cE * 6) Then
                    cF = cF - Abs(cE * 6)
                    cE = cE + Abs(cE)
                End If
            End If
              
        'Column I calculation (Individual)
        Case 9 'Column I
            'Store Inventory Removal value
            Ind = Range("I" & Target.Row).Value
            'Do the thing!
            cF = cF - Ind
            If cF < 0 And cE >= WorksheetFunction.RoundUp(Abs(cF / 6), 0) Then
                cE = cE - WorksheetFunction.RoundUp(Abs(cF / 6), 0)
                cF = cF + WorksheetFunction.RoundUp(Abs(cF / 6), 0) * 6
            ElseIf cE < WorksheetFunction.RoundUp(Abs(cF / 6), 0) And (cD * 24) >= Abs(cF) Then
                cD = cD - WorksheetFunction.RoundUp(Abs(cF / 24), 0)
                cE = cE + (WorksheetFunction.RoundUp(Abs(cF / 24), 0) * 24) / 6
                cE = cE - WorksheetFunction.RoundUp(Abs(cF / 6), 0)
                cF = cF + WorksheetFunction.RoundUp(Abs(cF / 6), 0) * 6
            Else
                cF = cF + (cE * 6) + (cD * 24)
                cE = cE - cE
                cD = cD - cD
            End If
    End Select

'Update Starting Inventory values after calculations
Range("D" & Target.Row).Value = cD
Range("E" & Target.Row).Value = cE
Range("F" & Target.Row).Value = cF

End If

'Enable events so the code can work again on next update
Application.EnableEvents = True
End Sub
That’s amazing, I’ll give it a shot man, thank you very much. So appreciated can I upvote you or something
 
Upvote 0
Added a line to not leave the code unworking if it encounters an error:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Declare variables to hold current Starting Inventory and Inventory Removal values
Dim cD As Long, cE As Long, cF As Long, Ind As Long, sixP As Long

'Disable Events to prevent unexpected events from triggering code
Application.EnableEvents = False

On Error GoTo ErrReset:

'Check to see if values changed within range of H7:I18
If Not Intersect(Target, Range("H7:I18")) Is Nothing And Target.Count = 1 And Target.Value <> 0 Then

'Store current Starting Inventory values
cD = Range("D" & Target.Row).Value
cE = Range("E" & Target.Row).Value
cF = Range("F" & Target.Row).Value

    'Perform cascading calculation based on which column was updated (6-pack(H) or Individual(I))
    Select Case Target.Column
        'Column H calculation (6-pack)
        Case 8 'Column H
            'Store Inventory Removal value
            sixP = Range("H" & Target.Row).Value
            'Do the thing!
            cE = cE - sixP
            If cE =< 0 And cD >= WorksheetFunction.RoundUp(Abs((cE * 6) / 24), 0) Then
                cD = cD - WorksheetFunction.RoundUp(Abs((cE * 6) / 24), 0)
                cE = cE + WorksheetFunction.RoundUp(Abs((cE * 6) / 24), 0) * 4
            Else
                cE = cE + (cD * 4)
                cD = cD - cD
                If cE < 0 And cF >= Abs(cE * 6) Then
                    cF = cF - Abs(cE * 6)
                    cE = cE + Abs(cE)
                End If
            End If
              
        'Column I calculation (Individual)
        Case 9 'Column I
            'Store Inventory Removal value
            Ind = Range("I" & Target.Row).Value
            'Do the thing!
            cF = cF - Ind
            If cF =< 0 And cE >= WorksheetFunction.RoundUp(Abs(cF / 6), 0) Then
                cE = cE - WorksheetFunction.RoundUp(Abs(cF / 6), 0)
                cF = cF + WorksheetFunction.RoundUp(Abs(cF / 6), 0) * 6
            ElseIf cE < WorksheetFunction.RoundUp(Abs(cF / 6), 0) And (cD * 24) >= Abs(cF) Then
                cD = cD - WorksheetFunction.RoundUp(Abs(cF / 24), 0)
                cE = cE + (WorksheetFunction.RoundUp(Abs(cF / 24), 0) * 24) / 6
                cE = cE - WorksheetFunction.RoundUp(Abs(cF / 6), 0)
                cF = cF + WorksheetFunction.RoundUp(Abs(cF / 6), 0) * 6
            Else
                cF = cF + (cE * 6) + (cD * 24)
                cE = cE - cE
                cD = cD - cD
            End If
    End Select

'Update Starting Inventory values after calculations
Range("D" & Target.Row).Value = cD
Range("E" & Target.Row).Value = cE
Range("F" & Target.Row).Value = cF

End If

ErrReset:
'Enable events so the code can work again on next update
Application.EnableEvents = True
End Sub
 
Last edited:
Upvote 1
Solution
I also want to add that if you enter an incorrect amount, or typo, the code is still going to run and then give you the wrong results. You would then have to reset columns D-F and enter the removal amount again. We could potentially add some code to serve as a temporary backup in case someone wasn't paying attention to the starting values before hand.
 
Upvote 0

Forum statistics

Threads
1,215,136
Messages
6,123,247
Members
449,093
Latest member
Vincent Khandagale

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top