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

ABHISKV4

New Member
Joined
May 26, 2009
Messages
31
Office Version
  1. 365
Platform
  1. Windows
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
BCDEFGHIJKLMNOPQRS
2Week1Week2Week3Week4Week5Week6Week7Week8Week9Week10Week11Week12Week13Week14Week15TOTALSum to Look for
3Sales Qty -->15595109159688673119102744888941951601625813
Sheet1 (2)
Cell Formulas
RangeFormula
R3R3=SUM(C3:Q3)
S3S3=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
ABCDEFGHIJKLMNOPQRST
7
81559510915968867311910274488894195160Finding Sum >= 813No. of cells such that >=813Remarks
91551552503595185866727458649661040108811761270146516258648Tie for 8 cell range, but not final answer as 864 is <= 880
10959520436343151759070981188593310211115131014708859
111091092683364224956147167908389261020121513758389
12159159227313386505607681729817911110612668179
136868154227346448522570658752947110794710
14868615927838045450259068487910398799
1573731922943684165045987939539539
161191192212953434315257208808808Tie for 8 cell range, this is final answer as 880 is >= 864
1710210217622431240660176100
18747412221030449965900
19484813623042558500
20888818237753700
21949428944900
2219519535500
23160
24
Sheet1 (2)
Cell Formulas
RangeFormula
C9C9=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,D9P9=O9+P$8
R9:R22R9=MIN(IF(D9:Q9>=$S$3,D9:Q9,""))
S9:S22S9=IF(R9=0,0,COUNTA($C9:INDEX(C9:Q9,0,MATCH(R9,C9:Q9,0))))
P22P22=P8
D10D10=D8
E11E11=E8
F12F12=F8
G13G13=G8
H14H14=H8
I15I15=I8
J16J16=J8
K17K17=K8
L18L18=L8
M19M19=M8
N20N20=N8
O21O21=O8
Press CTRL+SHIFT+ENTER to enter array formulas.
 
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:
Cell Formulas
RangeFormula
C9C9=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,D9P9=O9+P$8
R9:R22R9=MIN(IF(D9:Q9>=$S$3,D9:Q9,""))
S9:S22S9=IF(R9=0,0,COUNTA($C9:INDEX(C9:Q9,0,MATCH(R9,C9:Q9,0))))
P22P22=P8
D10D10=D8
E11E11=E8
F12F12=F8
G13G13=G8
H14H14=H8
I15I15=I8
J16J16=J8
K17K17=K8
L18L18=L8
M19M19=M8
N20N20=N8
O21O21=O8
Press CTRL+SHIFT+ENTER to enter array formulas.
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
If you like to highlight the minimum adjacent cells which add up to 50%:
VBA Code:
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
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0
An update which works both horizontally and vertically:
VBA Code:
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:
 
Upvote 0
@Sulprobil , Many thanks for the beautiful code for the same, appreciate your efforts and help (y). Sorry, got busy with office stuff, so could not thank you on time :)
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,211
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top