VBA offcut calculation

Cuprian

New Member
Joined
Oct 25, 2021
Messages
20
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi,
Let's say I have this set of data:
1635598121209.png


In colum E I want to display offcut with data from equation "B1 - all length with Nr 1, Nr 2, Nr 3, etc.)
Example:
E3 = B1- B3-B4-B5
E4 = B1- B6-B7-B8 etc.
Any ideas how can I acheive it using VBA?
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
VBA Code:
Range("E3").Formula = "= B1 - SUM(B3:B5)"
Range("E4").Formula = "= B1 - SUM(B6:B8)"

Etc.
 
Upvote 0
VBA Code:
Range("E3").Formula = "= B1 - SUM(B3:B5)"
Range("E4").Formula = "= B1 - SUM(B6:B8)"

Etc.
This was a sample data, normal data may vary (sometimes there could be 3x nr.1 sometimes 5x nr.1 ...). I need a code that will do the calculation with every given data
 
Upvote 0
How you suggest the start and end of each section be determined?

Edit: Disregard, I see it now.
 
Last edited:
Upvote 0
VBA Code:
Sub Test()
'
    Dim A_ColumnLoopCounter As Long
    Dim D_ColumnLoopCounter As Long
    Dim LastRowA            As Long
    Dim LastRowD            As Long
    Dim SubtractTotal       As Long
    Dim TableStartRow       As Long
'
    LastRowA = Cells(Rows.Count, "A").End(xlUp).Row
    LastRowD = Cells(Rows.Count, "D").End(xlUp).Row
    TableStartRow = 3
'
    For D_ColumnLoopCounter = 1 To Range("D" & LastRowD)
        For A_ColumnLoopCounter = TableStartRow To LastRowA
            If Range("A" & A_ColumnLoopCounter) = D_ColumnLoopCounter Then SubtractTotal = SubtractTotal + Range("B" & A_ColumnLoopCounter)
        Next
'
        Range("E" & D_ColumnLoopCounter + 2) = Range("B1") - SubtractTotal
        SubtractTotal = 0
    Next
End Sub


bluefeather.xlsm
ABCDEF
112050
2NrLengthNrcut
3150001120
4150002135
5119303135
6250004200
7250005505
82191562050
93500072050
103500082050
113191592050
1245000102050
1345000112050
1441850
1555000
1655000
1751545
1865000
1965000
2075000
2175000
2285000
2385000
2495000
2595000
26105000
27105000
28115000
29115000
30
Sheet3
 
Upvote 0

It can be also achieved under VBA without looping just with an easy formula …​
 
Upvote 0
According to post #6 attachment for starters :​
VBA Code:
Sub Demo1()
    With Range("E3", Cells(Rows.Count, 4).End(xlUp)(1, 2))
        .Formula = Replace("=$B$1-SUMIF($A$3:$A$#,D3,$B$3:$B$#)", "#", Cells(Rows.Count, 1).End(xlUp).Row)
        .Formula = .Value2
    End With
End Sub
 
Upvote 0
My demonstration revamped for a direct evaluation :​
VBA Code:
Sub Demo1r()
  Const F = "IF({1},B1-SUMIF(A3:A#,D3:D¤,B3:B#))"
    Dim L&
        L = Cells(Rows.Count, 4).End(xlUp).Row
        Range("E3:E" & L).Value2 = Evaluate(Replace(Replace(F, "¤", L), "#", Cells(Rows.Count, 1).End(xlUp).Row))
End Sub
 
Upvote 0
Perhaps a little less obvious, nevertheless as an additional choice a UDF ...

VBA Code:
Public Function SectSum(ByVal argSection As Long, ByVal argRng As Range) As Long
    Dim arr As Variant, i As Long, t As Long
    arr = argRng.Value
    For i = 1 To UBound(arr)
        If arr(i, 1) = argSection Then
            t = t + arr(i, 2)
        Else
            If t > 0 Then Exit For
        End If
    Next i
    SectSum = t
End Function


Book1
ABCDE
112050
2
3150001120
4150002135
5119303140
6250004220
7250005320
82191562050
93500072050
103500081050
113191090
12450001030
1345000112050
1441830
1555000
1655000
1751730
1865000
1965000
2075000
2175000
2285000
2386000
2496000
2596050
26106010
27106010
28115000
29115000
Sheet7
Cell Formulas
RangeFormula
E3:E13E3= $B$1 - sectsum(D3,$A$3:$B$36)
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,048
Members
448,543
Latest member
MartinLarkin

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