Add Remark in cloumn based on calculation/comparisons in one worksheet

[DocAElstein]

Before:
_____ Workbook: Actual File.xlsx ( Using Excel 2007 32 bit )

Row\Col	H	I	J	K	L	M	N	O	P	Q
1	LTP
2	63.3				1	60	1.055	1.055	54	56.97
3	56.65				6	60	0.94417	5.665	54	50.985
4	65.65				6	60	1.09417	6.565	54	59.085
5	73.05				1	60	1.2175	1.2175	54	65.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
9	87.9				1	60	1.465	1.465	54	79.11
10	81.65				6	51	1.60098	9.60588	54	86.4529
11	67.9				1	60	1.13167	1.13167	54	61.11
12	27				1	58	0.46552	0.46552	54	25.1379
13	18.4				6	42	0.4381	2.62857	54	23.6571
14	22.15				6	40	0.55375	3.3225	54	29.9025
15	72.05				1	55	1.31	1.31	54	70.74
16	94.35				1	60	1.5725	1.5725	54	84.915
17	62.5				6	60	1.04167	6.25	54	56.25
18	40.35				6	60	0.6725	4.035	54	36.315

Worksheet: Sheet1

After

_____ Workbook: Actual File.xlsx ( Using Excel 2007 32 bit )

Row\Col	H	I	J	K	L	M	N	O	P	Q
1	LTP
2	63.3		1		1	60	1.055	1.055	54	56.97
3	56.65		1		6	60	0.94417	5.665	54	50.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	65.745
6	63.1		1		6	60	1.05167	6.31	54	56.79
7	79.95		1		6	60	1.3325	7.995	54	71.955
8	27.55		1		1	60	0.45917	0.45917	54	24.795
9	87.9		1		1	60	1.465	1.465	54	79.11
10	81.65		1		6	51	1.60098	9.60588	54	86.4529
11	67.9		1		1	60	1.13167	1.13167	54	61.11
12	27		1		1	58	0.46552	0.46552	54	25.1379
13	18.4		1		6	42	0.4381	2.62857	54	23.6571
14	22.15		1		6	40	0.55375	3.3225	54	29.9025
15	72.05		1		1	55	1.31	1.31	54	70.74
16	94.35		1		1	60	1.5725	1.5725	54	84.915
17	62.5		1		6	60	1.04167	6.25	54	56.25
18	40.35		1		6	60	0.6725	4.035	54	36.315
19	287.65				6	60	4.79417	28.765	54	258.885

Worksheet: Sheet1

Sub CalculationAndRemark()
Rem 1 Worksheets info
Dim Wb As Workbook
 Set Wb = Workbooks("Actual File.xlsx")   '  Workbooks("Book1.xlsm") ' change to suit
Dim Ws1 As Worksheet: Set Ws1 = Wb.Worksheets.Item(1)
Dim Lr As Long
 Let Lr = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
Dim rngIn As Range: Set rngIn = Ws1.Range("A1:S" & Lr & "")
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