VBA Subtract until a certain value with condition

[BalloutMoe]

Hello All, looking for some guidance on this problem I am stuck on. I am sure it is doable just can't figure it out at the moment and my vba skills are not the best. Below is a table and I am looking to subtract until amount is zero with a condition to not go under $25.50 in Column B.
So starting with 800 in Range("D2") I would like to subtract full amount from column A as you can see until it reached Range("A9") if the remaining balance is smaller then cell value in range A I would like to keep 25.50 and continue on to the next row until the 800 balance is zero.

Any help would be appreciated

ColumnA	ColumnB	ColumnC
$177.57​	$0.00​	$622.43	$800
$145.00​	$0.00​	$477.43
$99.63​	$0.00​	$377.80
$98.50​	$0.00​	$279.30
$90.32​	$0.00​	$188.98
$88.79​	$0.00​	$100.19
$64.97​	$0.00​	$35.22
$48.74​	$25.50​	$11.98
$47.12​	$35.14​	$0.00
$46.26​	46.26
$39.00​	39
$39.00​	39
$39.00​	39
$39.00​	39
$39.00​	39
$24.00​	24
$24.00​	24
$24.00​	24
$20.00​	20
$18.39​	18.39
$7.00​	7

 

[Peter_SSs]

I figured it out this is working so far.

Glad you have something working. Thanks for letting us know.

If anybody has any improvements.

Difficult to offer anything since we appear to not have the whole code and it seems like that code is written for a different layout/data to that in post 1.

 

[BalloutMoe]

A3 contains the amount I want subtracted “800” and column D contains the amounts to subtract from like in column A

 

[Peter_SSs]

Thanks for the clarification of the different layout.
If there was going to be tens of thousands of rows or more then there may be adjustments that could speed it it up a little, otherwise I think that your current code should be fine.

 

[BalloutMoe]

Thanks for the clarification of the different layout.
If there was going to be tens of thousands of rows or more then there may be adjustments that could speed it it up a little, otherwise I think that your current code should be fine.

Yes it is a lot of rows and running inside a loop

 

[Peter_SSs]

Yes it is a lot of rows

What do you call "lot of rows"?

.. and what is happening with the loop?

I would like to set up a sample file to test with so I want to try as much as possible to replicate what you are doing.

 

[bebo021999]

Alternative with same result as #10:

Option Explicit
Sub subtract()
Dim lr&, i&, sum As Double, rng
With Sheet3
    lr = .Cells(Rows.Count, "D").End(xlUp).Row
    rng = .Range("D2:D" & lr).Value
    sum = .Range("A3").Value ' starting remaining sum
    For i = 1 To lr - 1
        If sum >= 25.5 * 2 Then ' if remaining sum >=51
            sum = sum - rng(i, 1) 'remaining sum updated
            rng(i, 1) = ""
        ElseIf sum >= 25.5 Then' if remaining sum >=25.5
            sum = sum - rng(i, 1) + 25.5
            rng(i, 1) = 25.5
        ElseIf sum > 0 Then
            rng(i, 1) = rng(i, 1) - sum
            sum = sum - rng(i, 1)
        End If
        .Range("D" & i + 1).Value = rng(i, 1)
    Next
End With
End Sub

 

[bebo021999]

Yes it is a lot of rows and running inside a loop

I did not pay attention to this, untill my last post was sent.
Below code may help code faster:

Option Explicit
Sub subtract()
Dim lr&, i&, sum As Double, rng
With Sheet3
    lr = .Cells(Rows.Count, "D").End(xlUp).Row
    rng = .Range("D2:D" & lr).Value
    sum = .Range("A3").Value
    For i = 1 To lr - 1
        If sum >= 25.5 * 2 Then
            sum = sum - rng(i, 1)
            rng(i, 1) = ""
        ElseIf sum >= 25.5 Then
            sum = sum - rng(i, 1) + 25.5
            rng(i, 1) = 25.5
        ElseIf sum > 0 Then
            rng(i, 1) = rng(i, 1) - sum
            sum = sum - rng(i, 1)
        End If
    Next
    .Range("D2").Resize(UBound(rng), 1).Value = rng
End With
End Sub