Sub ReverseSubtraction()
Dim ws As Worksheet
Dim lastRow As Long, lastCol As Long, i As Long, j As Long
Dim diffCol As Long
' Set the worksheet
Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with the actual name of your sheet
' Find the last row and column in the worksheet
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
' Find the column index for the DIFF column
diffCol = Application.Match("DIFF", ws.Rows(1), 0)
' Loop through each row in reverse order
For i = lastRow To 2 Step -1
' Loop through each column from H to C in reverse order
For j = lastCol - 1 To 8 Step -1
' Subtract the value in the DIFF column
If ws.Cells(i, diffCol).Value > 0 Then
ws.Cells(i, j).Value = WorksheetFunction.Max(ws.Cells(i, j).Value - ws.Cells(i, diffCol).Value, 0)
ws.Cells(i, diffCol).Value = IIf(ws.Cells(i, j).Value = 0, 0, ws.Cells(i, diffCol).Value - ws.Cells(i, j).Value)
End If
Next j
Next i
End Sub