Nest Do While loop in VBA does not end

Question

Can not figure out why the following code doesn't exit when it's 'supposed' to. Any help appreciated. The issue is the Parent Do While loop is not ending the loop as soon as the value RF hits 0.

Did I set this up completely wrong? Not too familiar with VBA, and haven't written a program in any language in a few years now so I'm very rusty.

Thank you in advance for any insight!

Private Sub CalculateButton_Click()
'Assigning Variables
Dim cid As Currency
Dim tip As Currency
Dim cha As Currency
Dim A1 As Currency
Dim R1 As Currency
Dim B1 As Boolean
Dim A5 As Currency
Dim R5 As Currency
Dim B5 As Boolean
Dim A10 As Currency
Dim R10 As Currency
Dim B10 As Boolean
Dim A20 As Currency
Dim R20 As Currency
Dim B20 As Boolean
Dim A50 As Currency
Dim R50 As Currency
Dim A100 As Currency
Dim R100 As Currency
Dim B100 As Boolean
Dim tipCalc As Double
Dim RF As Currency    

'Setting Boolean as false
B1 = False
B5 = False
B10 = False
B20 = False
B100 = False

'Setting Variables values
cid = 587.87
tip = 16
cha = 13
A1 = 36
R1 = 0
A5 = 85
R5 = 0
A10 = 50
R10 = 0
A20 = 420
R20 = 0
A50 = 0
R50 = 0
A100 = 0
R100 = 0
RF = 175
If A1 + A5 + A10 + A20 + A50 + A100 < RF Then
    MsgBox "Not Enough Money In Register"
    Exit Sub
End If


'Grabbing decimal from CID to calculate tip rounding next
tipCalc = cid - Int(cid)

'Calculating tip and entering into the excel sheet
'Removed for simplification

RF = RF - cha

Do While RF > 0
    Do While B1 = False 'This is for the 1 dollar bills
        If CheckWhole(RF, 5) And A1 < 5 Then
            B1 = True
            MsgBox "1 dollar done " & RF

        Else
            RF = RF - 1
            A1 = A1 - 1
            R1 = R1 + 1
        End If
    Loop
    MsgBox RF > 0
    Do While B5 = False '5 dollar bills
        If CheckWhole(RF, 10) And A5 < 10 Then
            B5 = True
            MsgBox "5 dollar done " & RF
        Else
            RF = RF - 5
            A5 = A5 - 5
            R5 = R5 + 5
        End If
    Loop
    MsgBox RF > 0
    Do While B10 = False '10 dollar bills
        If CheckWhole(RF, 20) And A10 < 20 Then
            B10 = True
            MsgBox "10 dollar done " & RF
        Else
            RF = RF - 10
            A10 = A10 - 10
            R10 = R10 + 10
        End If
    Loop
    MsgBox RF > 0
    Do While B20 = False '20 dollar bills
        If CheckWhole(RF, 100) And A20 < 100 Then
            B20 = True
            MsgBox "20 dollar done " & RF
        Else
            RF = RF - 20
            A20 = A20 - 20
            R20 = R20 + 20
            MsgBox "20 dollar working " & RF
        End If
    Loop
    MsgBox "a20 " & RF > 0

Loop
'Output goes here, inputs data into cells on spreadsheet.  



End Sub

Function CheckWhole(x As Currency, y As Currency) As Boolean
    If Int(x / y) = (x / y) Then
        CheckWhole = True
    Else
        CheckWhole = False
    End If
End Function

Note that I edited out some code that was working/doesn't pertain to the issue at hand.

And yes, I have a ton of variables. I know there's probably a much easier way to code what I'm attempting to do.

You should check in your inner loops, if the outer loop's condition is matched since you're manipulating its termination-condition — lokusking
– lokusking, Commented Aug 2, 2016 at 6:36
There is a logic hole in your code. When all the if conditions inside the inner loops are met, RF does not decrement, so the outer loop loops infinitely. — PA.
– PA., Commented Aug 2, 2016 at 6:46

DragonSamu · Accepted Answer · 2016-08-02 07:09:00Z

4

If you wish to stop the loop while its processing you need to put in a check before each new Do While to check if RF is equal to or less then 0:

if RF <= 0 then exit Do

answered Aug 2, 2016 at 7:09

DragonSamu

1,16110 silver badges18 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

Eric Over a year ago

Thanks this would work but I realized that a nested loop isn't really the best approach to this problem, going another route after being more awake!

Mats Lind · Accepted Answer · 2016-08-02 08:33:11Z

2

Eric, if I understand you right you do only wish execution to get into the inner loops if RF is positive. One simple way to do this is to add that requirement explicitly to all the inner loops. The first inner loop would e.g. look start like this then:

Do While RF > 0 And B1 = False'This is for the 1 dollar bills

If you do similar edits to the three other inner loops it might work as I think you intend it to. Regards, Mats

answered Aug 2, 2016 at 8:33

Mats Lind

9347 silver badges20 bronze badges

1 Comment

Eric Over a year ago

I'll attempt that thanks! I went to bed and realized that a nested loop wasn't really the best route

score 2 · Accepted Answer · 2016-08-02 09:19:56Z

DragonSamu is correct; you should add if RF <= 0 then exit Do before each inner loop.

Do While: will start the Loop if a conditions is meet
Loop Until: will restart the Loop until a conditions is meet

Here I created a Function TransferFunds to handle the inner loops. The parameters in TransferFunds use ByRef to modify the original variable from the main code.

Sub CheckRegister()
    Dim A1 As Currency, A5 As Currency, A10 As Currency, A20 As Currency, A50 As Currency, A100 As Currency
    Dim R1 As Currency, R5 As Currency, R10 As Currency, R20 As Currency, R50 As Currency, R100 As Currency
    Dim rf As Currency

    A1 = 36
    A5 = 85
    A10 = 50
    A20 = 420
    A100 = 0
    rf = 175

    TransferFunds rf, R1, A1, 1
    TransferFunds rf, R5, A5, 5
    TransferFunds rf, R10, A10, 10
    TransferFunds rf, R20, A20, 20
    TransferFunds rf, R50, A50, 50
    TransferFunds rf, R100, A100, 100

    RefundMessage "Refund Due", R1, "Ones", R5, "Fives", R10, "Tens", R20, "Twenties", R50, "Fifties", R100, "Hundreds"
    RefundMessage "Remaining Register", A1, "Ones", A5, "Fives", A10, "Tens", A20, "Twenties", A50, "Fifties", A100, "Hundreds"

End Sub

Sub TransferFunds(ByRef rf As Currency, ByRef RValue, ByRef AValue As Currency, Denomination As Integer)
    Dim RefundAmount As Currency

    If rf > AValue Then
        RValue = AValue
    Else
        RValue = RValue Mod Denomination
    End If

    AValue = AValue - RValue
    rf = rf - RValue

End Sub

Sub RefundMessage(Title As String, ParamArray arValuePairs() As Variant)
    Dim msg As String, Denomination As String
    Dim i As Integer, cValue As Currency

    For i = 0 To UBound(arValuePairs) Step 2
        cValue = arValuePairs(i)
        Denomination = arValuePairs(i + 1)
        If cValue > 0 Then
            msg = msg & FormatCurrency(cValue, 2) & " in " & Denomination & vbCrLf
        End If

    Next

    MsgBox msg, vbInformation, "Refund Due"
End Sub

Mono · Accepted Answer · 2016-08-02 06:47:00Z

0

first of all. The outer Loop will exit. But only if it reaches the respective "Loop" point in the code. So RF will get negative and the inner Loops will all finish before the outer Loop checks the condition for the next "round".

Except for that line:

MsgBox "a20 " & RF > 0

Your code will compile and run but maybe not as you expect. So instead of asking why your code is not working you should probably also explain what you want to achieve exactly.

answered Aug 2, 2016 at 6:47

Mono

7426 silver badges18 bronze badges

1 Comment

Eric Over a year ago

Was attempting to do this half asleep, have a clearer approach this morning, thank you though.

Collectives™ on Stack Overflow

Nest Do While loop in VBA does not end

4 Answers 4

1 Comment

1 Comment

1 Comment

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

1 Comment

1 Comment

1 Comment

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related