Do you need to highlight the minimum number of adjacent cells which sum up to a certain percentage of the total of a range?
Here you are:
Please read my Disclaimer.
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 '56End 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 top- or leftmost is taken.'https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbHighlightMinAdjacentCellsWhichSumUpToP'(C) (P) Bernd Plumhoff V0.1 07-Sep-2020Dim d As Double, dNew As Double, dMax As DoubleDim lMax As Long, i As Long, j As Long, k As LongDim v As Variant​With Application.WorksheetFunctionFor Each v In rr.Interior.ColorIndex = lColorIndexBaseNext vd = .Sum(r) * dPercentageFor i = 1 To r.CountdMax = 0#For j = 1 To r.Count - i + 1dNew = 0#For k = j To j + i - 1dNew = dNew + r(k)Next kIf dNew >= d ThenIf dNew > dMax ThendMax = dNewlMax = jEnd IfEnd IfNext jIf dMax > 0# Then Exit ForNext iFor j = lMax To lMax + i - 1r(j).Interior.ColorIndex = lColorIndexHighLightNext jIf Not rSum Is Nothing Then rSum = dMaxEnd WithEnd 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 wellEnd Sub