Macro to be to split an amount based on it value and spread over aperiod (months)

[TC]

Hi Friends

Any help will be appreciated. and thanks in advance.

I am looking for macro VBA code which I can assign to a button which
will do the following routine:

Essentially, the amounts will be recorded in column A2 onwards and the
criteria of spreading the "budget amount" (in coumns B onwards) is =<
$200 is one month, >200 to 500 is three months, >500<1000 is four
months and >1000 is 8 months.


Col A Col B Col C Col D Col E Col F Col G Col H
Amount Jun-08 Jul-08 Aug-08 Sep-08 Oct-08 Nov-08 Dec-08 Spread
<=200 x one month

200 < 500 x x x 3 Months
500 <1000 x x x x 4 months
1000 x x x x x x x 8 Months

Many thanks for your valuable time.

Cheers
Tony

 

[Mike H.]

This should do it:

Sub DoBudgetSpread()
Dim X As Double
Dim Y As Integer
X = 2
Do While True
If Cells(X, 1).Value = Empty Then Exit Do
If Cells(X, 1).Value <= 200 Then
Cells(X, 2).Value = Cells(X, 1).Value
ElseIf Cells(X, 1).Value > 200 And Cells(X, 1).Value <= 500 Then
For Y = 2 To 3
Cells(X, Y).Value = Round(Cells(X, 1).Value / 3, 2)
Next
Cells(X, 4).Value = Cells(X, 1).Value - Cells(X, 2).Value - Cells(X,
3).Value
ElseIf Cells(X, 1).Value > 500 And Cells(X, 1).Value <= 1000 Then
For Y = 2 To 4
Cells(X, Y).Value = Round(Cells(X, 1).Value / 4, 2)
Next
Cells(X, 5).Value = Cells(X, 1).Value - Cells(X, 2).Value - Cells(X,
3).Value - Cells(X, 4).Value
ElseIf Cells(X, 1).Value > 1000 Then
For Y = 2 To 8
Cells(X, Y).Value = Round(Cells(X, 1).Value / 8, 2)
Next
Cells(X, 9).Value = Cells(X, 1).Value - Cells(X, 2).Value - Cells(X,
3).Value - Cells(X, 4).Value - Cells(X, 5).Value - Cells(X, 6).Value -
Cells(X, 7).Value - Cells(X, 8).Value
End If
X = X + 1
Loop


End Sub