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