sorry, I started the thread by accident, explained more clearly in the thread
above. Tushar, thanks, I got it cornered now. The code selects an amount in
one sheet and divides it by the number of years it should be paid out over in
another sheet. In the code below, I have taken into account that the payment
of the first and last year should be multiplied by the fraction of the year
in which the person has a given age, therefore he doesn't get the full amount
the first and last year.
I take any advice I can get to make the code more elegant, so please feel
free. Thanks in advance.
Kragelund
Public Sub Export_P1R1()
Dim i As Integer, j As Integer, P1R1_udbt_start As Variant, P1R1_udbt_length
As Double, P1R1_amount_primo As Double
Dim Fraction_yr As Double
Dim MaxRowNumber As Double
With worksheets("Per.1 Rate.Pen. nr. 1")
P1R1_udbt_start = .Cells(3, 2).Value
P1R1_udbt_length = .Cells(4, 2).Value
P1R1_amount_primo = .Cells(5, 2).Value
End With
With worksheets("Per1")
Fraction_yr = .Cells(2, 3).Value
End With
With worksheets("IndtPer1")
..Cells(10, 1).Select
MaxRowNumber = .Range(ActiveCell, ActiveCell.End(xlDown)).Rows.Count
Range(.Cells(10, 6), (.Cells(MaxRowNumber + 10, 6))).Select
Selection.ClearContents
For i = 0 To MaxRowNumber
If .Cells(10 + i, 1).Value = P1R1_udbt_start Then
..Cells(10 + i, 6) = (Fraction_yr / 12) * P1R1_amount_primo
Exit For
End If
Next i
For j = 1 To P1R1_udbt_length - 2
..Cells(10 + i + j, 6) = P1R1_amount_primo * (1.02) ^ (j)
Debug.Print j
Next j
..Cells(10 + i + j, 6) = ((12 - Fraction_yr) / 12 * P1R1_amount_primo) * 1.02
^ j + 1
End With
End Sub
"Tushar Mehta" wrote:
Where (what line) is the error?
Also, in most cases, there is no need to activate or select objects. One
can refer to them directly. For example, use
With Worksheets("Per.1 Rate.Pen. nr. 1")
.Cells(16, 2).Value = P1R1_udbt_start
.Cells(30, 6).Value = P1R1_udbt_length
.Cells(31, 8).Value = P1R1_amount_primo
End With
There are other improvements possible but focus on the immediate error
first.
Also, I suspect that even after you fix the current problem the code will
not do what you want. The Cells(10 + P1R1_udbt_length, 12).Select appears
to be an attempt to position yourself at the next empty cell but then the
Cells(10 + i, 1).Select and other processing in the loop will overwrite the
data written in an earlier iteration of the loop.
--
Regards,
Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions
In article ,
says...
Public P1R1_udbt_start As Integer, P1R1_udbt_length As Integer,
P1R1_amount_primo As Double
Public Sub Export_P1R1()
Dim i As Integer, j As Integer
Dim sheets As worksheets
Dim worksheets As worksheets
worksheets("Per.1 Rate.Pen. nr. 1").Activate
With Cells
Set Cells(16, 2) = P1R1_udbt_start
Set Cells(30, 6) = P1R1_udbt_length
Set Cells(31, 8) = P1R1_amount_primo
End With
sheets("IndtPer1").Activate
For i = 0 To 55
On Error Resume Next
With Cells
Cells(10 + i, 1).Select
If Cells(10 + i, 1) = P1R1_udbt_start Then
Cells(10 + i, 12).Select
End If
For j = 0 To P1R1_udbt_length - 1
Cells(10 + i + j, 12) = P1R1_amount_primo
Next j
Cells(10 + P1R1_udbt_length, 12).Select
End With
Next i
sheets("Per.1 Rate.Pen. nr. 1").Select
End Sub