How to Automatically Recalculate a Production Plan in Excel Based on Daily Output Changes?

Question

[This is a plan i made]

I use this table to plan the production of threads for rugs. Each time I get a new order for a color, I introduce it manually and calculate the daily quotas by hand. The problem arises when we do not meet the planned output for a certain shift or day (e.g., instead of 1000kg, we made 800kg). This means I have to recalculate most of the plan, which is very time-consuming.

Details of the Plan:

Each machine in each step has a daily or shift limit. Machines like "Assembly," "Rewinding," "Spinning," "Flotor," and "Volkmann" combined can handle 1000kg per shift. "Dying" can only happen during the day shift. We always test every new color by making 550kg first. "Drying" is more efficient when drying all of one color before another, to save cleaning time. The calculation of the plan starts with the order amount of wool in the first row named "Order". We start "Calibrating" the wool at maximum capacity and efficiency(650kg). Once we have enough wool for testing a new color and a full dying batch (e.g., 550kg + 3000kg), we test the color and then dye the full batch the next working day. The drying process follows, ensuring all of one color is dried before starting another. The process continues similarly through other steps until "Thermotreatment," where different colors can be processed together up to 2000kg. The Goal:

I want to automate the recalculations so that if I change the value in one cell, the rest of the values adjust accordingly based on the initial plan.

Please ask for any clarifications, and I'll be extremely thankful for any help!

I tried an algorithm using the logic: if the sum of the cells of a certain color changes, add the change to the next available cell that != maximum amount of kg per shift. If cell == with maximum then add another one, but i can't seem to get how i should shift the values from other cells, and the efficency of the algorithm is questionable, thus i come here for help.

	15-Jul	16-Jul	17-Jul	18-Jul	19-Jul	20-Jul	21-Jul	22-Jul	23-Jul	24-Jul	25-Jul	26-Jul	27-Jul	28-Jul	01-Jul	02-Jul	03-Jul	04-Jul	05-Jul	06-Jul	07-Jul
	day	night	day	night	day	night	day	night	day	night	day	night	day	night	day	night	day	night	day	night	day	day	day	day	day	day	day	day	day	day	day
	A	B	A	B	A	B	A	B	A	B					A	B	A	B	A	B	A	A			A	A	A	A	A
Order	14,285
Calibration		650	650	650	650	650	650	650	650	650					650	650	650	650	650	650	250
Dying									550						2450	550	2000	1000	1900			1550
Drying																1200	1200	1200	1200	200	1200	1050			350
Laminate 3/4 (2%)																	1000	1000	1000	1000	900	1000			1000
Flotor(2%)																		1000	1000	1000	1000	1000			1000	802
Spinning(3%)																			1000	1000	1000	657.9			1000	1000
Rewinding(2%)																				1000	1000	1000			1000	1000	564.7
Assembly(2%)																					1000	1000			519.1	1000	1000
Volkmann1(2%)																						650			650	650	650	214.3
Volkmann2(2%)																						350			350	350	350	214.3
Thermotreatment(2%)
Delivery																											4429		4429

Answer 1

This is what I came up with:
*I decided to use screenshots for this, because the colors are integral for the functioning of code.

What it does

Now, say on 24.7., both day and night shift of "spinning" only made 100 kg of wool. When I change the values and update the table, this is what the macro produces:

I am not entirely sure if this is desired behavior since you haven't produced an example of an output. Let me know if you need it to behave differently

How to use it

Copy this code into a new VBA module:

Function changeValue(ByVal target As Range, newValue As Double)
    If target.Row < 8 Or target.Row > 16 Then Exit Function
    
    Dim oldValue As Double
    oldValue = target.Value
    
    Dim limitArr As Variant, limit As Double
    limitArr = Array(1200, 1000, 1000, 1000, 1000, 1000, 650, 350, 2000)
    limit = limitArr(target.Row - 8)
    
    Dim availWool As Double, totalWool As Double, dif As Double
    availWool = availableWool(target)
    totalWool = totalWoolOnRow(target)
    
    If newValue > availWool Or newValue > limit Then
        MsgBox "You only have " & availWool & " kg of wool available at this point" & vbCrLf & _
        "Also, the limit for this machine is set to: " & limit & " kg" & vbCrLf & _
        "The value will be reset back"
        target.Value = oldValue
        Exit Function
    End If

    Dim lwor As Range, newCell As Range
    Set lwor = lastWoolOnRow(target)
    Set newCell = nextNonWeekendCell(Cells(lwor.Row, lwor.Column + 1), 1)
    dif = newValue - oldValue
    'CHANGING LAST DAY
    If lwor = target Then
        If newValue < oldValue Then
            shift newCell, 1
            newCell.Value = -dif
            lwor.Value = newValue
            newCell.Interior.Color = target.Interior.Color
            Exit Function
        Else
            MsgBox "It is not possible to increase amount of wool on the last day."
            Exit Function
        End If
    End If
    'WHEN SHIFT RIGHT NECESSARY
    If lwor.Value - dif > limit Then
        shift newCell, 1
        newCell.Value = lwor.Value - dif - limit
        lwor.Value = limit
        newCell.Interior.Color = target.Interior.Color
        target.Value = newValue
        Exit Function
    End If
    Dim lw As Double
    lw = lwor.Value - dif
    'WHEN SHIFT LEFT POSSIBLE
    If lw <= 0 Then
        shift nextNonWeekendCell(Cells(lwor.Row, lwor.Column + 1), 1), -1
        nextNonWeekendCell(Cells(lwor.Row, lwor.Column - 1), -1).Value = nextNonWeekendCell(Cells(lwor.Row, lwor.Column - 1), -1).Value + lw
        target.Value = newValue
        Exit Function
    End If
    lwor.Value = lwor.Value - dif
    target.Value = newValue
End Function

Function shift(ByVal start As Range, ByVal shiftVal As Integer)
    Dim vals As Collection, currentCell As Range, startColor As Long
    startColor = start.Interior.Color
    Set vals = New Collection
    For i = start.Column To 78
        Set currentCell = Cells(start.Row, i)
        If currentCell.Interior.Color = startColor Then
            vals.Add currentCell.Value
            currentCell.Clear
        End If
    Next i
    
    Dim counter As Integer, weekendColor As Long
    weekendColor = 65535
    Set currentCell = nextNonWeekendCell(Cells(start.Row, start.Column + shiftVal), shiftVal)
    For Each v In vals
        currentCell.Value = v
        currentCell.Interior.Color = startColor
        Set currentCell = nextNonWeekendCell(Cells(currentCell.Row, currentCell.Column + 1), 1)
    Next v
End Function
Function availableWool(ByVal start As Range) As Double
    Dim currentCell As Range, currentCellMinus As Range
    For i = 2 To start.Column
        Set currentCell = Cells(start.Row - 1, i)
        Set currentCellMinus = Cells(start.Row, i)
        If currentCell.Interior.Color = start.Interior.Color Then
            availableWool = availableWool + currentCell.Value
        End If
        If currentCellMinus.Interior.Color = start.Interior.Color And i <> start.Column Then
            availableWool = availableWool - currentCellMinus
        End If
    Next i
End Function

Function totalWoolOnRow(ByVal start As Range) As Double
    Dim currentCell As Range
    For i = 1 To 78
        Set currentCell = Cells(start.Row, i)
        If currentCell.Interior.Color = start.Interior.Color Then
            totalWoolOnRow = totalWoolOnRow + currentCell.Value
        End If
    Next i
End Function
Function lastWoolOnRow(ByVal start As Range) As Range
    Dim currentRange As Range
    Set currentRange = Cells(start.Row, start.Column + 1)
    For i = start.Column To 78
        Set currentRange = Cells(start.Row, i)
        If currentRange.Interior.Color = start.Interior.Color Then
            Set lastWoolOnRow = Cells(start.Row, currentRange.Column)
        End If
    Next i
End Function
Function nextNonWeekendCell(ByVal start As Range, direction As Integer) As Range
    Dim counter As Integer, weekendColor As Long
    weekendColor = 65535
    Set currentCell = Cells(start.Row, start.Column)
    While currentCell.Interior.Color = weekendColor
        Set currentCell = Cells(currentCell.Row, currentCell.Column + direction)
    Wend
    Set nextNonWeekendCell = currentCell
End Function
Sub validate()
    Dim availWool As Double, currentValue As Integer
    For i = 8 To 16
        For j = 2 To 78
            If Cells(i, j).Interior.Color <> 16777215 Then
                currentValue = Cells(i, j).Value
                availWool = availableWool(Cells(i, j))
                If currentValue > availWool Then
                    changeValue Cells(i, j), availWool
                End If
            End If
        Next j
    Next i
End Sub
Sub chVSub()
    changeValue Selection, InputBox("enter new value")
    validate
End Sub

Select one cell only, run "chVSub" and enter a new value for the selected cell. The whole plan will be recalculated automatically

important notes

If the plan looks in any way different than what you showed, the code will almost definitely crash or destroy the plan completely. Because of this, I recommend always making a backup of the plan before using the macro.

Weekends must be marked yellow and it must be the yellow from the "standard colors" section of the color picker (rgb value 65535).

That's all I can think of now. I will put more in here if I find something.