Reducing over many cells

[Ben74]

Hi,

I have a problem with my code. Maybe somebody can help me.

I have 9 worksheets for every department of my company.
Every department has an own overtime sheet, the overtime is sorted by month and worker (Worker 1´s overtime is starting E5 (overtime 2016) to R5 (december 2017)).

The foremen writes freetime in Column "D". This freetime reduces the overtime (starting with E5). If e5 ist "0", the rest of the freetime reduces "F5" etc.

Example:
Worker 1 has 400 hours overtime in 2016, 20 in january 2017, 32 in february 2017....
foreman 2 writes 60 hours reducing freetime in "D5" = 340 hours overtime in 2016 for worker 1.
Worker 3 has 20 hours overtime in 2016, 20 hours in january 2017. etc.
Foreman 4 writes 30 hours reducing freetime in "d6" = 0 hours overtime left in 2016, 10 left in january 2017, etc.
Column "d" is emty after complete reduced.

My code has an error. It does not work.
Can you tell me where?
Thanks for your help.
Ben

Sub ReCalcOvertime()
Dim rng As Range
Dim rngAbgbH As Range, rngMon As Range
Dim iMon As Integer

For Each rng In Usedrange.Rows
Set rngAbgbH = rng.Cells(4, 4) ' reduced overtime
If IsNumeric(rngAbgbH) Then
For iMon = 4 To 18
Set rngMon = rng.Cells(4, 4 + iMon)
If rngAbgbH.Value >= rngMon.Value Then
rngAbgbH.Value = rngAbgbH.Value - rngMon.Value
rngMon.Value = 0
Else
rngMon.Value = rngMon.Value - rngAbgbH.Value
rngAbgbH.Value = 0
End If
If rngMon.Value = 0 Then
rngMon.ClearContents
End If
If rngAbgbH.Value = 0 Then
rngAbgbH.ClearContents
Exit For
End If
Next
End If
Next
End Sub