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
Bookmarks