Learning Do-Until Loops

[rickincanada]

Hi there! I'm trying to learn how to use VBA's Do-Until looping function to assist me in getting a payment rollback feature to work. I have a very simple workbook created that calculates a monthly payment based on the standard set of PMT Arguments. What I'm trying to do is get an input box that asks me what I want the monthly payment to be and then have it reduce or increase the Principal amount until it gets there.

Here's what I've written so far, however nothing happens after I enter my desired payment (NewPmnt) and click Yes.

Option Explicit

Sub PaymentRollback()
Dim NewPmnt As Variant
Dim OldPmnt As Double
'Range A4 is my Principal Amount

NewPmnt = InputBox("What do you want the payment to be?")
OldPmnt = Range("A6")

If Not IsNumeric(NewPmnt) Then
MsgBox ("You must enter a number!")
End If

If NewPmnt < 0 Then
MsgBox ("That's too low! Payment must be greater than 0.")

Do Until OldPmnt = NewPmnt
If NewPmnt > OldPmnt Then
Range("A4").Value = Range("A4").Value + 0.01
End If
Loop
Do Until OldPmnt = NewPmnt
If NewPmnt < OldPmnt Then
Range("A4").Value = Range("A4").Value - 0.01
End If
Loop
End If
End Sub

Thanks so much to anyone who can help. I'm really trying to learn this stuff on my own but this looping thing has me stuck!

 

[Norie]

rick

I don't quite understant what you are trying to do but the problem seems to be with the 2nd if.

You are checking if NewPmnt is less than zero, if it is then you are continuing with the rest of the code.

If isn't, ie it's more than zero, you skip to the End If and then Exit Sub.

I've got a feeling that isn't what you want to do.

Just noticed another problem - both your loops will be infinite because neither OldPmnt or NewPmnt will change.

You only seem to be changing the value of A4 in the worksheet.

Is that the value you actually want to use for comparison?

 

[rickincanada]

Ahhh, you've led me to my first couple problems. I think I'm going to need to do the payment calculation in VBA as opposed to on the workbook. I'm also going to need to collect the current principal amount and modify it in the sub and then return the solved value to the workbook. Thanks Norie!

 

[Norie]

So what is in A4?

Is it the payment calculation?

Perhaps a formula based on new/old payment?

 

[rickincanada]

A4 is the payment calculation - =IF(ISERROR(MonthlyPayment(A2,D2,C2)),A2/C2,MonthlyPayment(A2,D2,C2))

"MonthlyPayment" is a function I have in VBA.

 

[rickincanada]

OK, so I've moved all the logic over to VBA to calculate the payment. Here's how it looks:


Option Explicit

Function Payment(P As Double, J As Double, N As Double) As Double
Payment = P * (J / (1 - (1 + J) ^ -N))
End Function


Sub PaymentRollback()
Dim P As Double
Dim J As Double
Dim N As Double
Dim AdjP As Double
Dim K As Double
Dim Pmnt As Double

P = Range("$A$2") '20000
J = Range("$D$2") '0.002083333
N = Range("$C$2") '60
Pmnt = Payment(P, J, N) 'When this function is called on the worksheet with the above argument the result is 354.95
K = InputBox("What do you want the payment to be?")

If Not IsNumeric(K) Then
MsgBox ("You must enter a number!")
End If

If K < 0 Then
MsgBox ("That's too low! Payment must be greater than 0.")

Here's where I need help.

What I want to do is have the user (me in this case) enter a new payment in the input box and then have the procedure reduce/increase 'P' in the above calculation until the Payment function output value = the input box number.

I hope this makes some sense. I may be way off here. Thanks for looking at this with me

 

[Norie]

Well you'll need a loop for that.

There are a couple of things to consider as well - how will you increase/decrease P?

Are you still going for +/- 0.01?

What margin of error is acceptable, you'll probably need that because there's a possibility you aren't going to get an exact match.

You could actually use something else for that, eg stop after certain amount of iterations.

Or even change so it's equal to or more/less than.

Perhaps there's a specific method you can use for this sort of thing.

 

[rickincanada]

I'll try to answer your questions as best I can:

There are a couple of things to consider as well - how will you increase/decrease P? - I think to begin I will simply use the +/- 0.01. I'm sure this isn't the most efficient method but for learning purposes I'll use it to get started.

Margin of error - 0.01. I agree there will be some cases where I can't roll exactly to the payment. In that case I'll be happy with a payment 1 penny too high.

I imagine forcing it to stop after a certain number of iterations will work to start. I'm using this example for learning as I work with this type of problem regularly so it makes sense to me. Thank you SO much for your help!

 

[rickincanada]

So here's how far I've gotten:

Option Explicit

Function Payment(P As Double, J As Double, N As Double) As Double
Payment = P * (J / (1 - (1 + J) ^ -N))
End Function


Sub PaymentRollback()
Dim P As Double
Dim J As Double
Dim N As Double
Dim AdjP As Double
Dim K As Double
Dim Pmnt As Double

P = Range("$A$2") '20000
J = Range("$D$2") '0.002083333
N = Range("$C$2") '60
'Pmnt = Payment(P, J, N) 'When this function is called on the worksheet with the above argument the result is 354.95
K = InputBox("What do you want the payment to be?")

If Not IsNumeric(K) Then
MsgBox ("You must enter a number!")
End If

If K < 0 Then
MsgBox ("That's too low! Payment must be greater than 0.")
End If

Do Until Pmnt = K
Pmnt = Payment(P, J, N)
If K < Pmnt Then
P = P - 0.01
Else: P = P + 0.01
End If
Exit Do
Range("$A$2").Value = P
Loop

End Sub

As you can well imagine this still doesn't do anything

 

[Norie]

Rick

I think you should try the equal to more/less than then you won't be limited by a set no of iterations or rely on a margin of error.

I've not looked too much at the calculation itself but could it be possible to have large 'errors' then a penny?