Macro for a variable range sum if formula

[stunti]

Dear Community

Ive got a question regarding a sum if formula as macro (but unfortunately its not that easy - atleast for me)

Screenshot VBA.JPG

What i need is the following:
I have got a list of Groups (The Groups start always with Group#x) with names below.
Every name belongs to a city and has values (1 or 0) in the columns D,E,F & G
.
I would need to identify the sum for each column for City#1 for each group. (Row 2, Row 10)
The amount of Names for a Group can vary

Im already inserting the yellow row with a macro and the position where to put the formula is clear.
Its just that i can not get the variable range sumiff thing.

Is there a possibility to create a macro for this need? Unfortunately it is not possible to change Dataset

Thank you in advance for your help/advise
In case of question or unclaritiy please adress them.
Best Regards

[JKwan]

see if this does the trick

[Paul_Hossler]

Another approach (and the one I'd use) is to make the data more pivot table-friendly and just use a pivot table to analyze

The attachment has some examples

[stunti]

Thank you both. Unfortunately both solutions dont fit 100%.

I really need a macro which is taking the variable amount of lines which need to be included. Since this sheet i was sharing with you is only 1 small part of a big excel sheet with several tabs.
The yellow line is sth which is not existing when i copy paste the export into the sheet.
Im generating the Yellow line with a macro and the formula with the variable amount of lines should be part of it


Sub example()


Dim i As Long, intRow As Long
Application.ScreenUpdating = False
intRow = Cells(Rows.Count, 6).End(xlUp).Row
For i = intRow To 1 Step -1
If Cells(i, 6).Value = "xxx" Then
Rows(i).Insert Shift:=xlDown
Cells(i, 8).Value = "Groupname"
Cells(i, 9).Value = "City"
Application.ScreenUpdating = True


End If
Next i
End Sub




I would like to extend this macro
Cells(i, 12).Value = ?????
Cells(i, 13).Value = ?????

The Questionmark stand for the code im looking for. Im not a pro regarding macros and it might be that what i want is not even possible


Thank you in advance

[Paul_Hossler]

It's usually easier to understand fuzzy requirements if you can provide a separate Before tab ('What I start with") and a separate After tab ("Where I think I want to go")

Along with any processing or formulas

I would like to extend this macro
Cells(i, 12).Value =

?????

Cells(i, 13).Value =

?????

The Question mark stand for the code i'm looking for. I'm not a pro regarding macros and it might be that what i want is not even possible

For example, your attachment doesn't have any information at all about columns L and M so 'extend this macro' is pretty hard to figure out

[stunti]

I apologize you are right.

Here the Excel which corresponds with the Macro.

Example (1).xlsx

Its just a move of the columns since the extract uses the columns before h for something different

[Paul_Hossler]

1. I don't see the 'Before' in the Example, just the 'After'

2. The macro in the first post does not seem to apply to the corrected example

a. Column 6 is empty
b. What is "xxx"?
c. You want the literal strings "Groupname" and "City' inserted into each row?
d. Do anything with City #1 in rows 4 and 5?
e. Do you want a SUMIF type formula inserted by the macro, or just the results?

I think something like the attachment would be helpful to understand

Option Explicit

Sub example()

    Dim i As Long, intRow As Long

    Application.ScreenUpdating = False

    intRow = Cells(Rows.Count, 6).End(xlUp).Row

    For i = intRow To 1 Step -1
        If Cells(i, 6).Value = "xxx" Then
            Rows(i).Insert Shift:=xlDown
            Cells(i, 8).Value = "Groupname"
            Cells(i, 9).Value = "City"
        End If
    Next I

    Application.ScreenUpdating = True

End Sub

[stunti]

let me try to correct the example and give you the state before.

Example Before.xlsm

Thank you for your patience.

1. I don't see the 'Before' in the Example, just the 'After'

2. The macro in the first post does not seem to apply to the corrected example

a. Column 6 is empty
b. What is "xxx"?
c. You want the literal strings "Groupname" and "City' inserted into each row?
d. Do anything with City #1 in rows 4 and 5?
e. Do you want a SUMIF type formula inserted by the macro, or just the results?

1 - new example file
2a - corrected in the example file the xxx is given by export
2b - its a code from the export all cities got the xxx
2c - yes in each row which we have added by macro
2d - no nothing
2e - i just need the result -> another macro is taking the vlookup then (this already works)


Thank you again!!!

[Paul_Hossler]

I took your attachment and used 'Before' as input to the macro. For testing I used a different output sheet from your 'After' so that I could compare results from the macro to your 'After'

Look at 'AfterForTest'

Option Explicit
Sub example()
    Dim i As Long, intRow As Long, r As Long, c As Long, r1 As Long
    Dim ws As Worksheet
    Application.ScreenUpdating = False
    Set ws = Worksheets("AfterForTest")
    With Worksheets("Before")
        
        intRow = .Cells(.Rows.Count, 8).End(xlUp).Row
        
        For r = 1 To intRow
            If Left(.Cells(r, 8).Value, 5) = "Group" Then
                r1 = r
                ws.Cells(r, 6).Value = "xxx"
                ws.Cells(r, 8).Value = .Cells(r, 8).Value
                ws.Cells(r, 8).Resize(1, 7).Interior.ColorIndex = 15
                ws.Cells(r, 11).Resize(1, 4).Font.Bold = True
                ws.Cells(r, 11).Resize(1, 4).Font.Italic = True
            
            ElseIf Left(.Cells(r, 8).Value, 4) = "Name" Then
                ws.Cells(r, 6).Value = "yyy"
                ws.Cells(r, 8).Value = .Cells(r, 8).Value
                ws.Cells(r, 9).Value = .Cells(r, 9).Value
                For c = 11 To 14
                    If .Cells(r, c).Value > 0 Then
                        ws.Cells(r1, c).Value = ws.Cells(r1, c).Value + .Cells(r, c).Value
                        ws.Cells(r, c).Value = .Cells(r, c).Value
                    End If
                Next c
            End If
        Next r
    End With
                
    Application.ScreenUpdating = True
End Sub

[stunti]

Thank you very much for the effort you have put into this
but i think there was another mistake from my side


now i saw that there were 2 tabs.... in your file... . what i did in the after tab was meant to be before...

should be corrected now.

corrected example.xlsm

Thanks for teaching me how to describe a problem
i will do it better in the futue - i promise

Best Regards and a big thank you from Switzerland

[Paul_Hossler]

Try this - again I used 'AfterForTesting' to compare against your 'After'

Option Explicit
Sub example_2()
    Dim i As Long, intRow As Long, r As Long, c As Long, r1 As Long
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    
    Set ws = Worksheets("AfterForTesting")
    
    ' Pass #1 - copy over and add Group totals and formating
    With Worksheets("Before")
        
        intRow = .Cells(.Rows.Count, 6).End(xlUp).Row
        
        For r = 1 To intRow
            
            ws.Cells(r, 6).Value = .Cells(r, 6).Value
            ws.Cells(r, 8).Value = .Cells(r, 8).Value
            ws.Cells(r, 9).Value = .Cells(r, 9).Value
            
            
            If .Cells(r, 6).Value = "xxx" Then
                r1 = r
                ws.Cells(r, 8).Resize(1, 7).Interior.ColorIndex = 15
                ws.Cells(r, 11).Resize(1, 4).Font.Bold = True
                ws.Cells(r, 11).Resize(1, 4).Font.Italic = True
            
            ElseIf .Cells(r, 6).Value = "yyy" Then
                For c = 11 To 14
                    If .Cells(r, c).Value > 0 Then
                        ws.Cells(r1, c).Value = ws.Cells(r1, c).Value + .Cells(r, c).Value
                        ws.Cells(r, c).Value = .Cells(r, c).Value
                    End If
                Next c
            End If
        Next r
    End With
    
    ' Pass #2 - Insert Group-City lines and format
    With ws
        intRow = .Cells(.Rows.Count, 8).End(xlUp).Row
        
        For r = intRow To 1 Step -1
            
            If Len(.Cells(r, 9).Value) = 0 Then
                .Cells(r + 1, 6).Resize(1, 9).Insert Shift:=xlDown
                .Cells(r + 1, 6).Resize(1, 9).ClearFormats
                .Cells(r + 1, 6).Resize(1, 9).Interior.ColorIndex = 6
                .Cells(r + 1, 8).Value = .Cells(r, 8).Value & "City#1"
            End If
        Next r
    End With
    
    ' Pass #3 - add Group-City totals and form
    With ws
        r1 = 0
        intRow = .Cells(.Rows.Count, 6).End(xlUp).Row
        
        For r = 1 To intRow
            If Len(.Cells(r, 6).Value) = 0 Then
                r1 = r
                
            ElseIf r1 <> 0 Then
                If .Cells(r, 9).Value = "City#1" Then
                    For c = 11 To 14
                        If .Cells(r, c).Value > 0 Then
                            .Cells(r1, c).Value = .Cells(r1, c).Value + .Cells(r, c).Value
                        End If
                    Next c
                End If
            End If
        Next r
    End With
    
    Application.ScreenUpdating = True
End Sub

[stunti]

Yeah thank you very much. This was exactly what i needed.
Works great!

Just one question to understand everything a little better. where would i need to adjust the code to get 1-2 additonal columns to the count? in our example to get column o+p (currently empty) also summed up and shown in the result tab

Best Regards