Hello all . I have a tool written in which the number of applications received per person is calculated on the basis of work pattern and work rate and total occupancy hours . The routine in which the remainder is calculated must run until the remainder is zero . But it does not, ie he hangs at 44 and then it's an infinite loop .

I 've actually tested with breakpoints , Rij4 is just bigger than aantalcellen4 , that's not it .

Situated on the number, the rest is sometimes stabbing 44 . What is trying to do is as follows : For example, there are 250 applications spread over 80 people, but not equal , some others get hundred percent less according to claim persentage , overall occupancy and daylight hours ( = to see in the code ) . After the first partition thus s with a remainder , bijvoorveeld 40 or 100 or 51. Remaining I would then distribute those 80 people , according to the same formula , and just repeat this until most of the remainder is zero or can be no longer divided. Please Help.
I have attached the file in a zip, sorry, it is a bit in dutch, but is is VBA code :)

Here is the sub-routine:

Public Sub DeFormule()
'De waarde van de cellen van blad 2 in kolommen C, D, E, F, G zijn bijelkaar 100% werkpatroon
'De som van het aantal gewerkte uren in de week wordt met 100% vermenigvuldigd
'en door de standaard uren gedeeld. De uitkomst word in blad4, kolom G geplaatst.
Dim GemiddeldAantal As Long
Dim Uitkomst As Long
Dim DagUren As Long
Dim WeekUren As Long
Dim Claim1 As Variant
Dim Claim2 As Variant
Dim BelastbaarheidsFactor As Long
Dim SomBelastbaarheidsFactoren As Long
Dim Row As Long
Dim Wat As String
Dim NogWat As String
Dim teller As Integer
Dim Rest, hetaantal As Long

Let aantalcellen4 = Blad4.Range("A65500").End(xlUp).Row
If CLng(frmVerdeel.txtAantal.Text) < aantalcellen4 Then
MsgBox "Aantal is kleiner dan aantal medewerkers, graag handmatig verdelen..."
Blad4.Activate
Leeg
Exit Sub
End If
Let GemiddeldAantal = CLng((frmVerdeel.txtAantal.Text) / aantalcellen4)
Let hetaantal = CLng(frmVerdeel.txtAantal.Text)
' Let Honderdprocent = 100 + 8 + 38

Let Rij4 = 4
For Rij4 = 4 To aantalcellen4
Let Claim1 = Blad4.Cells(Rij4, 6).FormulaR1C1
Let Claim2 = Claim1
' If Claim2 > 5 Then Claim2 = 5
Let DagUren = Blad4.Cells(Rij4, 4).Value
Let BelastbaarheidsFactor = DagUren * Claim2
Let sombelastbaarheidsfactor = sombelastbaarheidsfactor + BelastbaarheidsFactor
' Let Rij4 = Rij4 + 1
Next Rij4

Let Rest = hetaantal - Val(WorksheetFunction.Sum(Blad4.Range("G4:G600")))
' Let teller = 1
Do While Rest > 0
Let Rest = hetaantal - Val(WorksheetFunction.Sum(Blad4.Range("G4:G600")))
Let Rij4 = 4
Do While Rij4 <= aantalcellen4
' If Not sombelastbaarheidsfactor = 0 Then
Let Claim1 = Val(Blad4.Cells(Rij4, 6).FormulaR1C1)
Let Claim2 = Claim1
' If Claim2 > 5 Then Claim2 = 5
Let DagUren = Blad4.Cells(Rij4, 4).Value
Let BelastbaarheidsFactor = DagUren * Claim2
Let Uitkomst = CLng((BelastbaarheidsFactor / sombelastbaarheidsfactor) * Rest)
Let Blad4.Cells(Rij4, 7).Value = Blad4.Cells(Rij4, 7).Value + Uitkomst
' Blad3.Activate
' Let Wat = CStr(Blad4.Cells(Rij4, 3).Value)
' If Not Blad4.Cells(Rij4, 7).Value = 0 Then
' Blad3.Cells.Find(What:=Wat, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
' :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
' False, SearchFormat:=False).Activate
' Let Row = Cells.Row
' Let ActiveCell(Row, 3).Value = ActiveCell(Row, 3).Value + Blad4.Cells(Rij4, 4).Value
' Let ActiveCell(Row, 5).Value = ActiveCell(Row, 5).Value + Round(Uitkomst)
' ' Let ActiveCell(Row, 3).Value = Blad4.Cells(Rij4, 4).Value
' End If
If Blad4.Cells(Rij4, 7).Value = 0 Then Blad4.Cells(Rij4, 7).Delete
Let Rij4 = Rij4 + 1
' Let teller = teller + 1
' End If
Loop
Loop