Trying to get vba to "loop until" with a count - vba

Question

I'm trying to get the code to read a value from an Input box which is the desired investment amount ie. 3000. Then to read down a list (40 rows long) of the amount of btc available at a particular price, and consecutively sum up these total dollar amounts (quantity*price) going down the list until the point where adding the next line would be greater than the desired investment amount (ie. I'm trying to see the cheapest way to acquire a bunch of btc).
I'll then write a bit to make it make up the rest of the value from the next line as it obviously won't be reached perfectly but I can't seem to get this bit to work. When I execute the code I'm getting some weird results that don't make much sense. I've put an example of a table in so you can see what I'm working with (The first price 94.25 is B3/ActiveCell)
This is probably extremely trivial but I've never done any of this stuff before. Thanks for your time and I hope I've outlined it clearly enough.
Sub Projected()
Dim InvestValue As Single
Dim SumBTCE As Single
Dim Sumup As Single
Dim NumBTC As Single
Dim Count As Integer
InvestValue = InputBox("Input investment amount:")
NumBTC = 0
Sumup = 0
ActiveWorkbook.Sheets("BTC-E Data").Cells(3, 2).Select
Do Until (Sumup + (ActiveCell.Offset(Count, 0).Value * ActiveCell.Offset(Count, 1).Value)) >= InvestValue
For Count = 1 To 40
Sumup = Sumup + ActiveCell.Offset(Count - 1, 0).Value * ActiveCell.Offset(Count - 1, 1).Value
NumBTC = NumBTC + ActiveCell.Offset(0, 1).Value
Next Count
Loop
MsgBox NumBTC
MsgBox Sumup
End Sub
price BTC USD
94.25 0.1 9.425
94.439 0.34583324 32.66014535
94.44 2 188.88
94.443 0.011 1.038873
94.444 0.4 37.7776
94.493 0.025 2.362325
94.5 0.1 9.45
94.55 0.1 9.455
94.6 0.1 9.46
94.601 0.5 47.3005
94.648 0.0112 1.0600576
94.649 4.12801098 390.7121112
94.65 35.75926753 3384.614672
94.664 2.128011 201.4460333
94.665 3.5 331.3275
94.679 0.1395 13.2077205
94.68 0.15 14.202
94.689 2.128011 201.4992336
94.69 18.73708352 1774.214439
94.698 0.010978 1.03959464
94.699 0.093 8.807007
94.7 0.1 9.47
94.704 0.025 2.3676
94.736 0.0837 7.9294032
94.737 0.09 8.52633
94.749 2.128011 201.6269142
94.75 20.1 1904.475
94.755 0.1 9.4755
94.8 0.1 9.48
94.801 0.03758691 3.56327665
94.81 5.7236763 542.66175
94.829 0.15 14.22435
94.84 0.20095058 19.058153
94.85 0.1 9.485
94.87 0.01 0.9487
94.879 0.401 38.046479
94.88 0.01 0.9488
94.887 0.40930425 38.83765236
94.89 0.01 0.9489
94.9 0.30106377 28.57095176

Answer 1

Here's how I'd do it:
A2 contains your goal, e.g., $3000.
C2:E41 contains your data
F2 formula:
=SUMPRODUCT((C$2:C2*D$2:D2))
G2 formula:
=SUM(F$2:F2)>=$A$2
H2 formula:
=IF(G2,MAX(0,$A$2-SUM(F$1:F1)),D2)
Then copy the formulas down.
You could combine these formulas, but it's easier to follow this way.

Answer 2

Try the code below
Sub Projected()
Dim InvestValue, SumBTCE, Sumup, NumBTC As Single
Dim Count, LastRow, BTC, Price As Integer
InvestValue = InputBox("Input investment amount:")
NumBTC = 0
Sumup = 0
With Worksheets("BTC-E Data")
LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row 'finding the last row in column 2
End With
For Count = 3 To LastRow
Price = ActiveWorkbook.Sheets("BTC-E Data").Range("B" & Count).Value
BTC = ActiveWorkbook.Sheets("BTC-E Data").Range("C" & Count).Value
Sumup = Sumup + (Price * BTC)
NumBTC = NumBTC + BTC
If Sumup >= InvestValue Then Exit For
Next
MsgBox NumBTC
MsgBox Sumup
End Sub
Output of the above code
NumBTC = 100.2461
Sumup = 9520.399976