Add/calculate lines on multiple criteria with loops based on values in other columns

Question

I have an excel sheet which looks like the following picture:

I need to:

Add up the Amount and Costs for each Position (all for 1, all for 2, all for 3, ...).
Then look for the "X" in Actual and then merge all the Rows where the Position value is equal on this row, so this should be the leading and only remaining row for this position at the end. BUT it should not be in the same sheet, but in a new one. Basically, in this example, there will be a second sheet with three rows (because of 3 Positions in this example)
It needs to be dynamic. There can be any amount of positions in here
The Description, Date, etc. from the Position with X in Actual should be adopted for each position.
There are even more columns and more calculations that need to be done, so it should be easy to add calculation criteria.

I am not an Excel Pro and I think it's not possible to solve this without coding a Makro, so feel free to prove me wrong...

So far I wrote the following VBA code based on some snippets I found online, but unfortunatly got stuck with adding up only specific rows (with the same position number) and output the sum in the position with "x" in Actual:

Sub MergeRows()
    Dim r_src As Range, r_dst As Range

    ' Pick 1st row and column of table
    Set r_src = Sheets("Sheet1").Range("A2")
    Set r_dst = Sheets("Sheet2").Range("A2")

    Dim i As Integer, j As Integer
    Dim N_rows As Integer, N_cols As Integer

    'Find the size of the data
    N_rows = CountRows(r_src)
    N_cols = CountColumns(r_src)

    'Resize source range to entire table
    Set r_src = r_src.Resize(N_rows, N_cols)

    Dim src_vals() As Variant, dst_vals() As Variant
    'Get all the values from source
    src_vals = r_src.Value2

    ReDim dst_vals(1 To N_rows, 1 To N_cols)
    Dim k As Integer
    Dim x As Integer
    k = 0
    For i = 1 To N_rows
        For x = 1 To 10
            ' Check first column
            If Val(src_vals(i, 1)) = x Then
                ' Increment count
                k = k + 1
                ' Copy row values

                Dim qty As Integer
                qty = qty + src_vals(i, 27)
                src_vals(i, 27) = qty

                For j = 1 To N_cols
                    If src_vals(i, 2) = "X" Then
                    dst_vals(k, j) = src_vals(i, j)
                    End If
                Next j

            End If
        Next x
        qty = 0
    Next i
    ' Bring rows back into destination range
    If k > 0 Then
        r_dst.Resize(k, N_cols).Value2 = dst_vals
    End If
End Sub
Public Function CountRows(ByRef r As Range) As Integer
    CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End Function
Public Function CountColumns(ByRef r As Range) As Integer
    CountColumns = r.Worksheet.Range("A:DS").Columns.Count
End Function

user_3219613 · Answer

Please check this

^{Image 1: Sorry for the German screenshot.

"Summe von Amount/Costs" means "Sum of Amount/Costs" and "Gesamtergebnis" means "Total result".}

which can be done with PivotTables (without using VBA) it updates dynamically.
See Create a PivotTable to analyze worksheet data.

Just add in the PivotTable Position to rows, and Amount and Costs to Values.

user_6480658 · Answer

You don't really need to loop through things, you can do the basic additions with a sumif formulae and then maybe just use a macro to automate applying the formulae on a 2nd sheet and I guess one quick loop to remove empty rows:

You can see the formulae works here:

And in the macro you'd just want something like

Sub e()
Sheet4.Range("A2:A9").Formula = "=SUM('Sheet_1'!C2:C3)"
Sheet4.Range("B2:B9").Formula = "=IF('Sheet_1'!$B2=""X"",SUMIF('Sheet_1'!$A$2:$E$9,'Sheet_1'!A2,'Sheet_1'!$E$2:$E$9),"""")"
End Sub

To apply the formula and then maybe

Sheet4.Range("A2:B9").value2 = Sheet4.Range("A2:B9").value2

To resolve them to just the numbers.

Then do a quick loop to remove blank values in column B.

NB You can still make it totally dynamic by subbing my hard-coded ranges for a variable and use your CountRows function.

Add/calculate lines on multiple criteria with loops based on values in other columns

2 Answers