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

P

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

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]L1[/TD]
[TD]100[/TD]
[TD]50[/TD]
[TD][/TD]
[TD]0[/TD]
[TD]-10[/TD]
[TD]100[/TD]
[TD][/TD]
[TD][/TD]
[TD]-50[/TD]
[/TR]
[TR]
[TD]L2[/TD]
[TD]0[/TD]
[TD][/TD]
[TD]200[/TD]
[TD]-100[/TD]
[TD]-50[/TD]
[TD]40[/TD]
[TD]-10[/TD]
[TD][/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]L3[/TD]
[TD][/TD]
[TD]300[/TD]
[TD][/TD]
[TD]-400[/TD]
[TD][/TD]
[TD]100[/TD]
[TD]50[/TD]
[TD][/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]L4[/TD]
[TD]100[/TD]
[TD]100[/TD]
[TD]100[/TD]
[TD]100[/TD]
[TD][/TD]
[TD]-450[/TD]
[TD]100[/TD]
[TD][/TD]
[TD]-50[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]L1_Result[/TD]
[TD]100[/TD]
[TD]40[/TD]
[TD][/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]50[/TD]
[TD][/TD]
[TD][/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]L2_Result[/TD]
[TD]0[/TD]
[TD][/TD]
[TD]50[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]30[/TD]
[TD]0[/TD]
[TD][/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]L3_Result[/TD]
[TD][/TD]
[TD]0[/TD]
[TD][/TD]
[TD]0[/TD]
[TD][/TD]
[TD]100[/TD]
[TD]50[/TD]
[TD][/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]L4_Result[/TD]
[TD]50[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD][/TD]
[TD]0[/TD]
[TD]50[/TD]
[TD][/TD]
[TD]0[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Sort by date Sort by votes
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
 
Upvote 0
RickXL said:
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
Click to expand...



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.

[TABLE="width: 500"]
<tbody>[TR]
[TD]1000
[/TD]
[TD]800
[/TD]
[TD][/TD]
[TD]50
[/TD]
[TD][/TD]
[TD]-250
[/TD]
[TD][/TD]
[TD]-100
[/TD]
[TD][/TD]
[TD]200
[/TD]
[TD][/TD]
[TD]-150
[/TD]
[TD]100
[/TD]
[TD]0
[/TD]
[TD]0
[/TD]
[TD]0
[/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]-200
[/TD]
[TD][/TD]
[TD]100
[/TD]
[TD]100
[/TD]
[TD]200
[/TD]
[/TR]
[TR]
[TD]1000
[/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]0
[/TD]
[TD]0
[/TD]
[TD]0
[/TD]
[TD]0
[/TD]
[TD]0
[/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]100
[/TD]
[TD]100
[/TD]
[TD]200
[/TD]
[/TR]
[TR]
[TD]1000
[/TD]
[TD]450
[/TD]
[TD][/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]0
[/TD]
[TD]0
[/TD]
[TD]0
[/TD]
[TD]0
[/TD]
[TD]0
[/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]0
[/TD]
[TD][/TD]
[TD]100
[/TD]
[TD]100
[/TD]
[TD]200
[/TD]
[/TR]
</tbody>[/TABLE]

Again thank you very much for helping me.
P
 
Upvote 0
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
 
Upvote 0
Hello

What if I want to subtract with specific Coloums

Thanks
Abdul Raheem
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Cell with 0 value showing blank
2
Replies
15
Views
654
mhessnm
M
C
  • Solved
Hiding Tabs using specific value in Cell
Replies
4
Views
85
cboyce44
C
V
  • Solved
Copy only Value not Formula to new Cell location after ActiveX Macro button pushed.
Replies
2
Views
148
VinnyDoesntKnowExcelCode
V
K
  • Question Question
Rolled up color coding
Replies
3
Views
232
felixstraube
F
F
  • Question Question
Formula to insert a picture based on various cell values, w/out VBA, Macros, etc.
Replies
4
Views
1K
Domenic
D

Forum statistics

Threads
1,223,239
Messages
6,170,947
Members
452,368
Latest member
jayp2104

Share this page

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
Back
Top