Before

_____ Workbook: Book1.xlsm ( Using Excel 2007 32 bit )
Row\Col
H
I
J
K
L
M
N
O
P
Q
R
S
T
1
 LTP
2
63.3
1
60
1.055
1.055
54
156.97
3
56.65
6
60
0.94417
5.665
54
550.985
4
65.65
6
60
1.09417
6.565
54
59.085
5
73.05
1
60
1.2175
1.2175
54
165.745
6
63.1
6
60
1.05167
6.31
54
56.79
7
79.95
6
60
1.3325
7.995
54
71.955
8
27.55
1
60
0.45917
0.45917
54
24.795
8000
9
87.9
1
60
1.465
1.465
54
79.11
9000
10
81.65
6
51
1.60098
9.60588
54
86.4529
 Profit Amount
1000
11
67.9
1
60
1.13167
1.13167
54
61.11
12
Worksheet: Sheet1

Results After running macro

_____ Workbook: Book1.xlsm ( Using Excel 2007 32 bit )
Row\Col
H
I
J
K
L
M
N
O
P
Q
R
S
T
1
 LTP
2
63.3
1
1
60
1.055
1.055
54
156.97
3
56.65
1
6
60
0.94417
5.665
54
550.985
4
65.65
1
6
60
1.09417
6.565
54
59.085
5
73.05
1
1
60
1.2175
1.2175
54
165.745
6
63.1
1
6
60
1.05167
6.31
54
56.79
7
79.95
6
60
1.3325
7.995
54
71.955
8
27.55
1
60
0.45917
0.45917
54
24.795
8000
9
87.9
1
60
1.465
1.465
54
79.11
9000
10
81.65
6
51
1.60098
9.60588
54
86.4529
 Profit Amount
1000
11
67.9
1
60
1.13167
1.13167
54
61.11
12
Worksheet: Sheet1


Code:
'     https://excelfox.com/forum/showthread.php/2489-Calculation-amp-Remark
'
Sub CalculationAndRemark()
Rem 1 Worksheets info
Dim Wb As Workbook
 Set Wb = Workbooks("Book1.xlsm") ' change to suit
Dim Ws1 As Worksheet: Set Ws1 = Wb.Worksheets.Item(1)
Dim rngIn As Range: Set rngIn = Ws1.Range("A1:S11")
Dim arrIn() As Variant, arrOut() As Variant: Let arrIn() = rngIn.Value2
Dim S10Val As Double: Let S10Val = arrIn(10, 19)
Rem 2 Do it untill we are past 1000
 Let arrOut() = arrIn()
Dim Cnt As Long, SomeTotal As Double
 Let Cnt = 2: Let SomeTotal = arrIn(Cnt, 17)
    Do
     Let arrOut(Cnt, 10) = 1
     Let Cnt = Cnt + 1
     Let SomeTotal = SomeTotal + arrIn(Cnt, 17)
    Loop While SomeTotal < S10Val
Rem 3 Output
 Let rngIn.Value2 = arrOut()


End Sub