Minimum no. of consecutive cells such that the sum is greater than a target number

[ABHISKV4]

Query: Need to find minimum no. of consecutive cells, from above yellow highlighted range, such that the sum is >= "sum to Look for" (here 813). In case of a tie, i.e. say there are two sets of 8 cells which give value >= "sum to look for", then the block whose sum is higher, should be shown as the result.

EXCEL - Minimum range of cells such that the sum is greater than a target number 06Sep2020 FINAL.xlsx
	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
2		Week1	Week2	Week3	Week4	Week5	Week6	Week7	Week8	Week9	Week10	Week11	Week12	Week13	Week14	Week15	TOTAL	Sum to Look for
3	Sales Qty -->	155	95	109	159	68	86	73	119	102	74	48	88	94	195	160	1625	813
Sheet1 (2)

Cell Formulas
Range	Formula
R3	R3	=SUM(C3:Q3)
S3	S3	=ROUNDUP(50%*R3,0)

Further illustration can be seen below:

EXCEL - Minimum range of cells such that the sum is greater than a target number 06Sep2020 FINAL.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
7
8			155	95	109	159	68	86	73	119	102	74	48	88	94	195	160	Finding Sum >= 813	No. of cells such that >=813	Remarks
9		155	155	250	359	518	586	672	745	864	966	1040	1088	1176	1270	1465	1625	864	8	Tie for 8 cell range, but not final answer as 864 is <= 880
10		95		95	204	363	431	517	590	709	811	885	933	1021	1115	1310	1470	885	9
11		109			109	268	336	422	495	614	716	790	838	926	1020	1215	1375	838	9
12		159				159	227	313	386	505	607	681	729	817	911	1106	1266	817	9
13		68					68	154	227	346	448	522	570	658	752	947	1107	947	10
14		86						86	159	278	380	454	502	590	684	879	1039	879	9
15		73							73	192	294	368	416	504	598	793	953	953	9
16		119								119	221	295	343	431	525	720	880	880	8	Tie for 8 cell range, this is final answer as 880 is >= 864
17		102									102	176	224	312	406	601	761	0	0
18		74										74	122	210	304	499	659	0	0
19		48											48	136	230	425	585	0	0
20		88												88	182	377	537	0	0
21		94													94	289	449	0	0
22		195														195	355	0	0
23		160
24
Sheet1 (2)

Cell Formulas
Range	Formula
C9	C9	=C8
P9:Q21,Q22,O9:O20,N9:N19,M9:M18,L9:L17,K9:K16,J9:J15,I9:I14,H9:H13,G9:G12,F9:F11,E9:E10,D9	P9	=O9+P$8
R9:R22	R9	=MIN(IF(D9:Q9>=$S$3,D9:Q9,""))
S9:S22	S9	=IF(R9=0,0,COUNTA($C9:INDEX(C9:Q9,0,MATCH(R9,C9:Q9,0))))
P22	P22	=P8
D10	D10	=D8
E11	E11	=E8
F12	F12	=F8
G13	G13	=G8
H14	H14	=H8
I15	I15	=I8
J16	J16	=J8
K17	K17	=K8
L18	L18	=L8
M19	M19	=M8
N20	N20	=N8
O21	O21	=O8
Press CTRL+SHIFT+ENTER to enter array formulas.

 

[ABHISKV4]

I thought the OP was interested in the actual cells which make up 50% of the total amount but if he says thank you then he seems to be satisfied with just the amount.

Yes, I am actually interested in the actual consecutive cells which make up 50% of the total amount, but in the given example 10000 is actually skewing the whole data, causing the target number to become 5789 which is possible only when the sum range includes the cell having 10000, hence the right answer is 10000, please see below:

EXCEL - Minimum range of cells such that the sum is greater than a target number 06Sep2020 FINAL with Answer 1 to 3 with VBA function.xlsm
	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
8		155	95	109	159	68	86	73	119	102	74	10000	88	94	195	160	Finding Sum >= Target	No. of cells such that >=Target	Remarks
9	155	155	250	359	518	586	672	745	864	966	1040	11040	11128	11222	11417	11577	11040	11
10	95		95	204	363	431	517	590	709	811	885	10885	10973	11067	11262	11422	10885	10
11	109			109	268	336	422	495	614	716	790	10790	10878	10972	11167	11327	10790	9
12	159				159	227	313	386	505	607	681	10681	10769	10863	11058	11218	10681	8
13	68					68	154	227	346	448	522	10522	10610	10704	10899	11059	10522	7
14	86						86	159	278	380	454	10454	10542	10636	10831	10991	10454	6
15	73							73	192	294	368	10368	10456	10550	10745	10905	10368	5
16	119								119	221	295	10295	10383	10477	10672	10832	10295	4
17	102									102	176	10176	10264	10358	10553	10713	10176	3
18	74										74	10074	10162	10256	10451	10611	10074	2
19	10000											10000	10088	10182	10377	10537	10000	1	Answer
20	88												88	182	377	537	0	0
21	94													94	289	449	0	0
22	195														195	355	0	0
23	160
Fail Scenario1

Cell Formulas
Range	Formula
C9	C9	=C8
P9:Q21,Q22,O9:O20,N9:N19,M9:M18,L9:L17,K9:K16,J9:J15,I9:I14,H9:H13,G9:G12,F9:F11,E9:E10,D9	P9	=O9+P$8
R9:R22	R9	=MIN(IF(D9:Q9>=$S$3,D9:Q9,""))
S9:S22	S9	=IF(R9=0,0,COUNTA($C9:INDEX(C9:Q9,0,MATCH(R9,C9:Q9,0))))
P22	P22	=P8
D10	D10	=D8
E11	E11	=E8
F12	F12	=F8
G13	G13	=G8
H14	H14	=H8
I15	I15	=I8
J16	J16	=J8
K17	K17	=K8
L18	L18	=L8
M19	M19	=M8
N20	N20	=N8
O21	O21	=O8
Press CTRL+SHIFT+ENTER to enter array formulas.

 

[ABHISKV4]

If you like to highlight the minimum adjacent cells which add up to 50%:

Option Explicit

Private Enum xlCI 'Excel Color Index
: xlCIBlack = 1: xlCIWhite: xlCIRed: xlCIBrightGreen: xlCIBlue '1 - 5
: xlCIYellow: xlCIPink: xlCITurquoise: xlCIDarkRed: xlCIGreen '6 - 10
: xlCIDarkBlue: xlCIDarkYellow: xlCIViolet: xlCITeal: xlCIGray25 '11 - 15
: xlCIGray50: xlCIPeriwinkle: xlCIPlum: xlCIIvory: xlCILightTurquoise '16 - 20
: xlCIDarkPurple: xlCICoral: xlCIOceanBlue: xlCIIceBlue: xlCILightBrown '21 - 25
: xlCIMagenta2: xlCIYellow2: xlCICyan2: xlCIDarkPink: xlCIDarkBrown '26 - 30
: xlCIDarkTurquoise: xlCISeaBlue: xlCISkyBlue: xlCILightTurquoise2: xlCILightGreen '31 - 35
: xlCILightYellow: xlCIPaleBlue: xlCIRose: xlCILavender: xlCITan '36 - 40
: xlCILightBlue: xlCIAqua: xlCILime: xlCIGold: xlCILightOrange '41 - 45
: xlCIOrange: xlCIBlueGray: xlCIGray40: xlCIDarkTeal: xlCISeaGreen '46 - 50
: xlCIDarkGreen: xlCIGreenBrown: xlCIBrown: xlCIDarkPink2: xlCIIndigo '51 - 55
: xlCIGray80 '56
End Enum

Sub sbHighlightMinAdjacentCells50P(r As Range)
'Highlights in pink the minimum adjacent cells of r which sum up to 50% of the overall total.
'If more than one range certifies then the max is taken.
'If more than one range still has same max the leftmost is taken.
Dim d As Double, dNew As Double, dMax As Double
Dim lMax As Long, i As Long, j As Long
Dim v As Variant

With Application.WorksheetFunction
For Each v In r
    r.Interior.ColorIndex = xlCIYellow
Next v
d = .Sum(r) / 2#
For i = 1 To r.Count
    dMax = 0#
    For j = 1 To r.Count - i + 1
        dNew = .Sum(r.Offset(0, j - 1).Resize(1, i))
        If dNew >= d Then
            If dNew > dMax Then
                dMax = dNew
                lMax = j
            End If
        End If
    Next j
    If dMax > 0# Then Exit For
Next i
For j = lMax To lMax + i - 1
    r(j).Interior.ColorIndex = xlCIPink
Next j
End With
End Sub

Sub doit()
Call sbHighlightMinAdjacentCells50P([C3:Q3])
End Sub

Many thanks for this awesome code to highlight the resultant range, this is of great help to me, much appreciated

 

[Sulprobil]

You have a somewhat unfortunate setup of your spreadsheet, moving the total each month one cell to the right.
What is your ideal solution over time, let us say from January to December?
Do you just need the highlighting, or also the cell sum, and if yes, where?

 

[ABHISKV4]

You have a somewhat unfortunate setup of your spreadsheet, moving the total each month one cell to the right.
What is your ideal solution over time, let us say from January to December?
Do you just need the highlighting, or also the cell sum, and if yes, where?

I was actually a bit carried away with the solution to the problem and hence forgot to plan well the location of the result cell. I will definitely do that better in my future posts. Here, the sample data is just a sample, the yellow highlighted cells can be many more. In the given example it is weeks, but it could also be days or anything else, so the range could very well vary from 15 cells to say 365 cells or even higher. Initially I needed only the cell sum, but now I realize it will be even good to have highlighting as well. The ideal cell where the answer can be placed would be T3. Please let me know If i need to provide any more information, thanks for all your help.

 

[Sulprobil]

An update which works both horizontally and vertically:

Private Enum xlCI 'Excel Color Index
: xlCINone = 0: xlCIBlack: xlCIWhite: xlCIRed: xlCIBrightGreen: xlCIBlue  '1 - 5
: xlCIYellow: xlCIPink: xlCITurquoise: xlCIDarkRed: xlCIGreen '6 - 10
: xlCIDarkBlue: xlCIDarkYellow: xlCIViolet: xlCITeal: xlCIGray25 '11 - 15
: xlCIGray50: xlCIPeriwinkle: xlCIPlum: xlCIIvory: xlCILightTurquoise '16 - 20
: xlCIDarkPurple: xlCICoral: xlCIOceanBlue: xlCIIceBlue: xlCILightBrown '21 - 25
: xlCIMagenta2: xlCIYellow2: xlCICyan2: xlCIDarkPink: xlCIDarkBrown '26 - 30
: xlCIDarkTurquoise: xlCISeaBlue: xlCISkyBlue: xlCILightTurquoise2: xlCILightGreen '31 - 35
: xlCILightYellow: xlCIPaleBlue: xlCIRose: xlCILavender: xlCITan '36 - 40
: xlCILightBlue: xlCIAqua: xlCILime: xlCIGold: xlCILightOrange '41 - 45
: xlCIOrange: xlCIBlueGray: xlCIGray40: xlCIDarkTeal: xlCISeaGreen '46 - 50
: xlCIDarkGreen: xlCIGreenBrown: xlCIBrown: xlCIDarkPink2: xlCIIndigo '51 - 55
: xlCIGray80 '56
End Enum

Sub sbHighlightMinAdjacentCellsWhichSumUpToP(r As Range, dPercentage As Double, _
    Optional rSum As Range, Optional lColorIndexBase As Long = 0, _
    Optional lColorIndexHighLight As Long = xlCIGray25)
'Highlights in lColorIndexHighLight the minimum number of adjacent cells of r
'which sum up to dPercentage of the overall total. If rSum is given, the observed
'achieved sum is returned in here.
'If more than one range certifies then the max is taken.
'If more than one range still has same max the leftmost is taken.
'https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbHighlightMinAdjacentCellsWhichSumUpToP
'(C) (P) Bernd Plumhoff V0.1 07-Sep-2020
Dim d As Double, dNew As Double, dMax As Double
Dim lMax As Long, i As Long, j As Long, k As Long
Dim v As Variant

With Application.WorksheetFunction
For Each v In r
    r.Interior.ColorIndex = lColorIndexBase
Next v
d = .Sum(r) * dPercentage
For i = 1 To r.Count
    dMax = 0#
    For j = 1 To r.Count - i + 1
        dNew = 0#
        For k = j To j + i - 1
            dNew = dNew + r(k)
        Next k
        If dNew >= d Then
            If dNew > dMax Then
                dMax = dNew
                lMax = j
            End If
        End If
    Next j
    If dMax > 0# Then Exit For
Next i
For j = lMax To lMax + i - 1
    r(j).Interior.ColorIndex = lColorIndexHighLight
Next j
If Not rSum Is Nothing Then rSum = dMax
End With
End Sub

Sub doit()
Call sbHighlightMinAdjacentCellsWhichSumUpToP([C3:Q3], 0.5, [T3])
Call sbHighlightMinAdjacentCellsWhichSumUpToP([B12:B26], 0.5, [B29], _
    xlCIBrightGreen, xlCIGreen) 'Test whether this works vertically as well
End Sub

You can also find this together with a sample file here:

sbHighlightMinAdjacentCellsWhichSumUpToP | Sulprobil

berndplumhoff.gitbook.io

 

[ABHISKV4]

@Sulprobil , Many thanks for the beautiful code for the same, appreciate your efforts and help . Sorry, got busy with office stuff, so could not thank you on time