Find value in column where running total is equal to a certain percentage

Question

I want to determine in Excel which numbers make up 75% of the entire value. To put it another way, if I combine all the largest values together, which ones should I add to get to 75% of the total? (largest to smallest). Finding the "cut-off value," or the minimum number to include in the set of numbers (that add up to 75%), is what I'm looking for. But I don't want to do this before organizing my data.

As you can see in the sample below, the cutoff is at "Company 6," which translates into a "cut-off value" of 750.

I just need to determine what the "cut-off value" should be so that I can know that if the value in the row is greater than that amount, it is a part of the group of values that make up 75% of the total because the data I have is not sorted.

Excel or VBA could be the solution, however, I'd prefer to avoid sorting my data first and having a calculation in each row (so ideally a single formula that can calculate it).

Row number	Amount	Percentage	Running Total
Company 1	1,000	12.9%	12.9%
Company 2	950	12.3%	25.2%
Company 3	900	11.6%	36.8%
Company 4	850	11.0%	47.7%
Company 5	800	10.3%	58.1%
Company 6	750	9.7%	67.7%
Company 7	700	9.0%	76.8%
Company 8	650	8.4%	85.2%
Company 9	600	7.7%	92.9%
Company 10	550	7.1%	100.0%
Total	7,750
75% of total	5,813

Answer 1

VBA bubble sort - no changes to the sheet.

Option Explicit

Sub calc75()

    Const PCENT = 0.75

    Dim rng, ar, ix, x As Long, z As Long, cutoff As Double
    Dim n As Long, i As Long, a As Long, b As Long
    Dim t As Double, msg As String, prev As Long, bFlag As Boolean
   
    ' company and amount
    Set rng = Sheet1.Range("A2:B11")
    ar = rng.Value2
    n = UBound(ar)
   
    ' calc cutoff
    ReDim ix(1 To n)
    For i = 1 To n
       ix(i) = i
       cutoff = cutoff + ar(i, 2) * PCENT
    Next

    ' bubble sort
    For a = 1 To n - 1
        For b = a + 1 To n
            ' compare col B
            If ar(ix(b), 2) > ar(ix(a), 2) Then
                z = ix(a)
                ix(a) = ix(b)
                ix(b) = z
            End If
        Next
    Next
   
    ' result
    x = 1
    For i = 1 To n
        t = t + ar(ix(i), 2)
        If t  > cutoff And Not bFlag Then
           msg = msg & vbLf & String(30, "-")
           bFlag = True
           If i > 1 Then x = i - 1
        End If
        
        msg = msg & vbLf & i & ") " & ar(ix(i), 1) _
             & Format(ar(ix(i), 2), "  0") _
             & Format(t, "  0")
   Next
   
   MsgBox msg, vbInformation, ar(x, 1) & " Cutoff=" & cutoff

End Sub