Fill numbers based on Sum

[janu319]

Hallo,


Hope someone can help me with this request.
I have numbers between 4 and 24 in the column B(from cell B2 to B161).
I want to fill the cells in the column C with 1 to 63, based on the sum of the cells in column B.
If the sum of continuous cells in column B(minimum 1 and maximum 5 cells) is <= 24, then fill 1 for those corresponding cells in column C. Then jump to next cells and repeat the same procedure and fill 2 and so on.


In this sample, the sum of B2 to B6(5 cells) is 20, so fill C2 to C6 with 1.
Sum of B7 to B10 is 21(adding B11 makes is 29), so fill C7 to C11 with 2.
At B16, adding B17 makes is 27, so C16 filled with 5.


Can this be achieved with formulas?
Looks like it is possible with a for loop and if loops in a VBA, but I'm not good in it.

Thanks in advance.

Kind regards,
Janu

Fill_Numbers.xlsx
	A	B	C
1	S.No	Count	Fill numbers
2	1	4	1
3	2	4	1
4	3	4	1
5	4	4	1
6	5	4	1
7	6	4	2
8	7	4	2
9	8	6	2
10	9	7	2
11	10	8	3
12	11	9	3
13	12	8	4
14	13	11	4
15	14	4	4
16	15	16	5
17	16	11	6
18	17	7	6
19	18	9	7
20	19	5	7
21	20	5	7
22	21	4	7
23	22	4
24	23	9
25	24	6
26	25	12
27	26	5
28	27	12
29	28	11
30	29	6
31	30	5
32	31	13
33	32	16
34	33	4
35	34	5
36	35	7
37	36	8
38	37	8
39	38	4
40	39	4
41	40	6
Sheet2

 

[Glenn Kennedy]

Is the criterion <24 or <=24? In one place you sate <=24, but somewhere esle, you increment column C by 1 when the total was 20 and the next total was 24....

 

[janu319]

Is the criterion <24 or <=24? In one place you sate <=24, but somewhere esle, you increment column C by 1 when the total was 20 and the next total was 24....

<=24.

 

[kevin9999]

Please try the following on a copy of your workbook. Change the sheet name to suit.

Option Explicit
Sub janu319()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet2")       '<-- *** Change sheet name to suit ***
    Dim a, b, i As Long, j As Long, x As Long
    a = ws.Range("B2:B" & ws.Cells(Rows.Count, "B").End(xlUp).Row)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    j = 1    
    For i = 1 To UBound(a, 1)
        x = x + a(i, 1)
        If x <= 24 Then
            b(i, 1) = j
        Else
            x = 0
            i = i - 1
            j = j + 1
        End If
    Next i
    ws.Range("C2").Resize(UBound(b, 1)).Value = b
End Sub

 

[janu319]

Thank you Kevin9999.
It almost meets my requirement except one thing, I can only sum 5 continuous cells, not 6.

Fill_Numbers.xlsx
	A	B	C
1	S.No	Count	Fill numbers
2	1	4	1
3	2	4	1
4	3	4	1
5	4	4	1
6	5	4	1
7	6	4	1
8	7	4	2
9	8	6	2
10	9	7	2
11	10	8	3
12	11	9	3
13	12	8	4
14	13	11	4
15	14	4	4
16	15	16	5
17	16	11	6
18	17	7	6
19	18	9	7
20	19	5	7
21	20	5	7
22	21	4	7
23	22	4	8
24	23	9	8
25	24	6	8
26	25	12	9
27	26	5	9
28	27	12	10
29	28	11	10
30	29	6	11
31	30	5	11
32	31	13	11
33	32	16	12
34	33	4	12
35	34	5	13
36	35	7	13
37	36	8	13
Sheet2

 

[kevin9999]

Sorry, I missed that
Try this instead

Option Explicit
Sub janu319()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet2")       '<-- *** Change sheet name to suit ***
    Dim a, b, i As Long, j As Long, k As Long, x As Long
    a = ws.Range("B2:B" & ws.Cells(Rows.Count, "B").End(xlUp).Row)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    j = 1: k = 1
    For i = 1 To UBound(a, 1)
        x = x + a(i, 1)
        If x <= 24 And k <= 5 Then
            b(i, 1) = j
            k = k + 1
        Else
            x = 0
            i = i - 1
            j = j + 1
            k = 1
        End If
    Next i
    ws.Range("C2").Resize(UBound(b, 1)).Value = b
End Sub

 

[janu319]

No problem.
yes, it worked. Thank you so much for you time and help..

 

[kevin9999]

Happy to help, and thanks for the feedback