VBA Grouped Rows to Increase/Decrease with Source Range

Question

I currently use the below code (MACRO1) to copy ALL of the rows (variable in quantity) from the sheet "Template" and paste them to the Active Sheet to the first blank row. All pasted rows except the first row, are then grouped, and a number in the first row incremented. Each time the macro is run, another "set" (all rows in Template) is pasted to the next blank row of the active sheet and then grouped and the next incremented number placed in its first row.

What I would like to do in addition is:

When rows on the Template sheet are changed (formula, data, row addition/deletion etc), then I want to manually run another macro (MACRO2) to update EACH of the existing groups on all sheets, so that they remain the same as the the rows in "Template". The only difference being the Template rows are not grouped.

Option Explicit
Sub Macro1()
    Dim copySheet As Worksheet, pasteSheet As Worksheet, ws As Worksheet, LRow As Long, csLastRow As Long, i As Long, StartNumber As Long, varString As String
    Set copySheet = ThisWorkbook.Worksheets("Template")
    varString = copySheet.Cells(2, 2).Value2
    Set pasteSheet = ThisWorkbook.ActiveSheet
    StartNumber = 1
    ActiveSheet.Outline.ShowLevels RowLevels:=2, ColumnLevels:=0
    With pasteSheet
        If .Name = "Template" Then MsgBox "Cannot Paste to Template": Exit Sub
        If Application.WorksheetFunction.CountA(.Cells) = 0 Then
            LRow = 2
        Else
            LRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            For i = LRow To 1 Step -1
                If .Cells(i, 2).Value2 = varString Then
                    StartNumber = .Cells(i, 6).Value2 + 1
                    Exit For
                End If
            Next i
        End If
        If .Outline.SummaryRow <> xlSummaryAbove Then .Outline.SummaryRow = xlSummaryAbove
            csLastRow = copySheet.Cells(Rows.Count, 1).End(xlUp).Row
            copySheet.Range("2:" & csLastRow).Copy
            .Rows(LRow).PasteSpecial Paste:=xlPasteAll
            .Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(.Rows.Count, 1).End _
                                           (xlUp).Offset(-(csLastRow - 3), 1)).EntireRow.Group
             ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=0
            .Cells(LRow, 6).Value = StartNumber
            .Cells(LRow, 6).NumberFormat = "000"
    End With
End Sub

Here are 2 screenshots of how this works.

Where the incrementation result mentioned in step 3 is placed on the sheet? Then, for step 4, you probably will need a different code than the one pasting to the first empty row? Now, how to interpret these "each increase or decrease"? Will they happen only to the last row(s)? Can they happen on another row? I meant to delete or insert a row inside the rows range, but not the last... If such a last case may exist, how to handle it? Besides all that, it should be recommended to edit your question and paste the code you have. Otherwise, the question may be closed.. — FaneDuru
Incrementation is in the top summary row of the group. The changes to the Rows could just be a value or formula change. Deleting or Inserting rows could be inside the rows range or at the beginning/end. I had tried manually to import data using Microsoft Query to see if this was even possible and none of the formulas come across, but I am very new at this and surely doing something wrong. — aye cee
I do not know where from the "summary row of the group" may be taken by the new code. That's why I asked where is it placed on the sheet? Isn't it? Should it be calculated for the last group? So, if the code should be manually run, deleting the last group and placing the new 'situation' should not well reflect what you want? — FaneDuru
The summary row just refers to the first row of the rows on the Template sheet. It is the only one not in the group that remains visible with the incremented number. If it could be automatic it is ok too, infact better, but I just thought maybe it could not be done. — aye cee
I would like to believe that almost everything can be done, but you must clearly describe the existing situation, with all possible changes, versus what you need. A picture with existing situation and another one with the desired one will also help. Now, I must confess that I do not understand exactly what is to be done and I never start working something without being sure I understood what is it about. Even if I think that I understood, it is not impossible that OP missed something... I still do not understand how to be used that "summary row of the group"... — FaneDuru

FaneDuru FaneDuru · Accepted Answer · 2021-07-29T17:47:29

Please, test the next code:

Sub UpdateSheetsLastGroup()
   Dim copySheet As Worksheet, ws As Worksheet, lastRow As Long, firstR As Long, csLastRow As Long

    Set copySheet = ThisWorkbook.Worksheets("Template")
    csLastRow = copySheet.cells(copySheet.rows.count, 1).End(xlUp).row
    
    For Each ws In ThisWorkbook.Worksheets
         With ws
            If .Name <> "Template" Then                                 'skip the "Template" sheet
                'if the summary row is not above, set it to be above:
                If .Outline.SummaryRow <> xlSummaryAbove Then .Outline.SummaryRow = xlSummaryAbove '
                .Outline.ShowLevels RowLevels:=8                        'expand all groups in the sheet to correctly return last row
                lastRow = .Range("A" & .rows.count).End(xlUp).row  'last row
                firstR = firstGrRow(ws, lastRow)                        'first row of the last  rows group
                .rows(firstR & ":" & lastRow).OutlineLevel = 1          'ungroup the found rous group
                .rows(firstR & ":" & lastRow).ClearContents             'clear contents of the ungroupped rows
                
                copySheet.Range("2:" & csLastRow).Copy                  'copy the range
                .rows(firstR).PasteSpecial Paste:=xlPasteAll            'paste it in the former first row
                
                'group skipping the first copied row:
                .Range(.cells(.rows.count, 1).End(xlUp), .cells(.rows.count, 1).End _
                                               (xlUp).Offset(-(csLastRow - 3), 1)).EntireRow.Group
                'added after editing:
                With .cells(firstR, 6)
                    .value = copySheet.cells(2, 2).Value2
                    .NumberFormat = "000"
                End With
            End If
         End With
    Next
End Sub

Function firstGrRow(sh As Worksheet, lastR As Long) As Long
   Dim i As Long
   For i = lastR To 1 Step -1
        If sh.rows(i).OutlineLevel <> 2 Then firstGrRow = i: Exit Function
   Next i
End Function

VBA Grouped Rows to Increase/Decrease with Source Range

1 Answers