VBA code to subtract cell value from previous cell values for every line

paneiro

New Member
Joined
May 30, 2015
Messages
3
Hello, i rather new vba and i have found great a difficulty to find a solution for this problem.
I have a flat xls table with 100000+ rows and 100+ columns with blank cells, 0 value cells, >0 value cells and <0 cells . What i want to do is a vba code to run through every line and when it finds a <0 value cell to go back and start subtracting this value from the previous cells until it comes to =0 OR >0 (subtract only from the positive ones). Then continue from were it stopped (the negative value) until the end of the line. Then it has to loop for every line until the end. Blank and 0 cells are considered as 0 value.Please see below an example of a test dataset and the desired results. The "tricky" part is in Line 3 where the subtraction leads to negative result since there are no more values to subtract and in this case sets the cell value to 0.

Thank you in advance
P

L1100500-10100-50
L20200-100-5040-1050
L3300-4001005030
L4100100100100-450100-50
L1_Result1004000500
L2_Result0500030050
L3_Result001005030
L4_Result500000500

<tbody>
</tbody>
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

RickXL

MrExcel MVP
Joined
Sep 9, 2013
Messages
4,328
Hi and welcome to the MrExcel Message Board.

I have assumed that your L4 result of 50 is not right. That is the one in the first column. If I haver followed the logic correctly it should be 0?

Also you mention over 100,000 rows. As far as I know the best way to do that is by using arrays in VBA. So I have done that. There must be resource limitations at some point but on my Intel Q6600 with 8GB it worked OK. I tested it with 100,000 rows and 1,000 columns. I did not check each result!

You need to paste this code into a new Module and run it from there.
The sheet names can be overtyped if you are using others.
It finds the used rows and columns before it starts.
The processing is row by row and resets itself at the end of a row.
The columns are processed from right to left forming a cumulative sum of the negative values as it progresses.
These negative values are added to the positive values until another negative value is found.
I was not too clear on the logic here so please respond with some more representative test data if I have made the wrong guess.

Code:
Sub Calc()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim arrData As Variant
    Dim lr As Long
    Dim lc As Long
    Dim iRow As Long
    Dim iCol As Long
    Dim cuSum As Long
    Dim negSeq As Boolean
    
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")

    With ws1
        lr = .Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
        lc = .Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
        arrData = .Range("A1").Resize(lr, lc)

        For iRow = 1 To UBound(arrData, 1)
            cuSum = 0
            For iCol = UBound(arrData, 2) To 2 Step -1
                If arrData(iRow, iCol) < 0 Then
                    cuSum = cuSum + arrData(iRow, iCol)
                    arrData(iRow, iCol) = 0
                End If
                
                If arrData(iRow, iCol) > 0 Then
                    If (arrData(iRow, iCol) + cuSum) > 0 Then
                        arrData(iRow, iCol) = arrData(iRow, iCol) + cuSum
                        cuSum = 0
                    Else
                        cuSum = cuSum - arrData(iRow, iCol)
                        arrData(iRow, iCol) = 0
                    End If
                End If
                
            Next
        Next
    End With
    
    With ws2
        .Cells.Clear
        .Range("A1").Resize(lr, lc) = arrData
    End With
    
    MsgBox "Calculation Completed"
    
End Sub
 

paneiro

New Member
Joined
May 30, 2015
Messages
3
Hi and welcome to the MrExcel Message Board.

I have assumed that your L4 result of 50 is not right. That is the one in the first column. If I haver followed the logic correctly it should be 0?

Also you mention over 100,000 rows. As far as I know the best way to do that is by using arrays in VBA. So I have done that. There must be resource limitations at some point but on my Intel Q6600 with 8GB it worked OK. I tested it with 100,000 rows and 1,000 columns. I did not check each result!

You need to paste this code into a new Module and run it from there.
The sheet names can be overtyped if you are using others.
It finds the used rows and columns before it starts.
The processing is row by row and resets itself at the end of a row.
The columns are processed from right to left forming a cumulative sum of the negative values as it progresses.
These negative values are added to the positive values until another negative value is found.
I was not too clear on the logic here so please respond with some more representative test data if I have made the wrong guess.

Code:
Sub Calc()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim arrData As Variant
    Dim lr As Long
    Dim lc As Long
    Dim iRow As Long
    Dim iCol As Long
    Dim cuSum As Long
    Dim negSeq As Boolean
    
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")

    With ws1
        lr = .Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
        lc = .Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
        arrData = .Range("A1").Resize(lr, lc)

        For iRow = 1 To UBound(arrData, 1)
            cuSum = 0
            For iCol = UBound(arrData, 2) To 2 Step -1
                If arrData(iRow, iCol) < 0 Then
                    cuSum = cuSum + arrData(iRow, iCol)
                    arrData(iRow, iCol) = 0
                End If
                
                If arrData(iRow, iCol) > 0 Then
                    If (arrData(iRow, iCol) + cuSum) > 0 Then
                        arrData(iRow, iCol) = arrData(iRow, iCol) + cuSum
                        cuSum = 0
                    Else
                        cuSum = cuSum - arrData(iRow, iCol)
                        arrData(iRow, iCol) = 0
                    End If
                End If
                
            Next
        Next
    End With
    
    With ws2
        .Cells.Clear
        .Range("A1").Resize(lr, lc) = arrData
    End With
    
    MsgBox "Calculation Completed"
    
End Sub



Hello RickXL thank you very much for your reply,

you are right about the L4 mistake and i am very sorry for that. What i want the code to do is actually to go from left to right until it finds a negative value, do the calculations to the left and when it reaches to the accepted result (>=0), start going to the right again from the cell that found the negative value, until the next cell with a negative value that will turn it back to left again. (there is a case that in the second turn to left it will end further than the previous one which means that it will change the numbers of the first one). Below is a test sample the first line represent the actual data, the second line the data after running the code and the third one result that should be given.

1000
800
50
-250
-100
200
-150
100
0
0
0
0
-200
100
100
200
1000
0
0
0
0
0
0
0
0
0
0
0
0
100
100
200
1000
450
0
0
0
0
0
0
0
0
0
0
0
100
100
200

<tbody>
</tbody>

Again thank you very much for helping me.
P
 

RickXL

MrExcel MVP
Joined
Sep 9, 2013
Messages
4,328
Hi,

I think there was only a sign wrong.

However, I notice that your new data has 1000 in column 1 and not L1 etc. I assumed that the real data included labels in column 1.
If that is not the case and data starts in column 1 then the red 2 in the code below will need to be changed into a 1.

Please try this:

Rich (BB code):
Sub Calc()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim arrData As Variant
    Dim lr As Long
    Dim lc As Long
    Dim iRow As Long
    Dim iCol As Long
    Dim cuSum As Long
    Dim negSeq As Boolean
    
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")

    With ws1
        lr = .Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
        lc = .Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
        arrData = .Range("A1").Resize(lr, lc)

        For iRow = 1 To UBound(arrData, 1)
            cuSum = 0
            For iCol = UBound(arrData, 2) To 2 Step -1
                If arrData(iRow, iCol) < 0 Then
                    cuSum = cuSum + arrData(iRow, iCol)
                    arrData(iRow, iCol) = 0
                End If
                
                If arrData(iRow, iCol) > 0 Then
                    If (arrData(iRow, iCol) + cuSum) > 0 Then
                        arrData(iRow, iCol) = arrData(iRow, iCol) + cuSum
                        cuSum = 0
                    Else
                        cuSum = cuSum + arrData(iRow, iCol)
                        arrData(iRow, iCol) = 0
                    End If
                End If
                Debug.Print cuSum
                .Cells(iRow + 1, iCol) = arrData(iRow, iCol)
            Next
        Next
    End With
    
    With ws2
        .Cells.Clear
        .Range("A1").Resize(lr, lc) = arrData
    End With
    
    MsgBox "Calculation Completed"
    
End Sub
 

paneiro

New Member
Joined
May 30, 2015
Messages
3

ADVERTISEMENT

And it works perfectly. Thank you very much for this RickXL :)
 

abdul7019

New Member
Joined
May 7, 2022
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Hello

What if I want to subtract with specific Coloums

Thanks
Abdul Raheem
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,290
Messages
5,836,445
Members
430,430
Latest member
Tomexcel2022

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top