Insert rows at specific points

luis gaspper
Lounger
Posts: 25
Joined: 03 Aug 2020, 05:23

Insert rows at specific points

Post by luis gaspper »

Dear experts,
Just a little modifications if possible
The macro below to Transfer specific columns from one sheet to two sheets based on Column L as illustrated in the attachment It works very well
but I'm having difficulty in inserting 9 blank rows between each table after each 25 items.. these rows would be as shown below:
- in the first inserted row for the total sum
- As for the second inserted row to the eighth inserted row will remain empty.
- in the Nine inserted row for the previous total
In the yellow cells I need to SUM the totals of the previous range
the two yellow cells will be the same as the second one will be equal to the first ( I have put the formulas manually )
I have put the expected output in Output sheet
How can I modify or add code to proceed with this Topic? Thank you.
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 68741
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Insert rows at specific points

Post by HansV »

Welcome to Eileen's Lounge!

I will take a look at it, but it might take a while.
Regards,
Hans

User avatar
HansV
Administrator
Posts: 68741
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Insert rows at specific points

Post by HansV »

Your current code inserts a signature row after every 25 rows. I don't see that in the Output sheet. Does that mean that there is no need for the signature rows?
Regards,
Hans

luis gaspper
Lounger
Posts: 25
Joined: 03 Aug 2020, 05:23

Re: Insert rows at specific points

Post by luis gaspper »

Thanks a lot Mr. Hans
Yes, that is correct I don't need for the signature rows

User avatar
HansV
Administrator
Posts: 68741
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Insert rows at specific points

Post by HansV »

Here is a modified version for the first stage sheet. The code for the second stage sheet will be similar.

Code: Select all

    'First stage sheet
    clm = Array(5, 4, 6, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42)
    strRws = Split(Data)
    ReDim Rws(1 To UBound(strRws) + 1, 1 To 1)
    For cnt = 1 To UBound(strRws) + 1
        Rws(cnt, 1) = strRws(cnt - 1)
    Next cnt

    arrOut = Application.Index(wM.Cells, Rws, clm)
    wF.Activate
    wF.Range("6:" & wF.Rows.Count).Clear
    wF.Range("6:" & wF.Rows.Count).Delete
    m = UBound(arrOut, 1)
    With wF.Range("A5").Resize(UBound(arrOut, 1), UBound(arrOut, 2))
        .Value = arrOut
        .Sort Key1:=wF.Range("C5"), Header:=True
    End With

    n = Application.Ceiling(m / 25, 1)
    For i = n To 1 Step -1
        r = 6 + 25 * i
        wF.Range("A" & r).Resize(9).EntireRow.Insert
        wF.Range("C" & r).Value = "total amount"
        wF.Range("D" & r).Resize(1, 23).FormulaR1C1 = "=IF(SUM(R[-25]C:R[-1]C)=0,"""",SUM(R[-25]C:R[-1]C))"
        If i < n Then
            wF.Range("C" & r + 8).Value = "previous amount"
            wF.Range("D" & r + 8).Resize(1, 23).FormulaR1C1 = "=R[-8]C"
        End If
        wF.HPageBreaks.Add wF.Range("A" & r + 8)
        With wF.Range("A" & r - 26 & ":Z" & r)
            .Font.Name = "Times New Roman"
            .Font.Size = 13
            .RowHeight = 18
            .Borders.LineStyle = xlContinuous
        End With
    Next i

    wF.UsedRange.EntireColumn.AutoFit
Regards,
Hans

luis gaspper
Lounger
Posts: 25
Joined: 03 Aug 2020, 05:23

Re: Insert rows at specific points

Post by luis gaspper »

That's great. Thank you very much for your great help.
how can change the row height for those rows that contains "Total" and "previous total" and the main header in row 5 to 45 points.
Thanks again.

User avatar
HansV
Administrator
Posts: 68741
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Insert rows at specific points

Post by HansV »

Insert the following lines above Next i:

Code: Select all

        wF.Range("A" & r - 26).RowHeight = 45
        wF.Range("A" & r).RowHeight = 45
Regards,
Hans

luis gaspper
Lounger
Posts: 25
Joined: 03 Aug 2020, 05:23

Re: Insert rows at specific points

Post by luis gaspper »

Thank you very much Mr. Hans
I have added this lines but the inserted rows changed to 45 points.

Code: Select all

      End With
      wF.Range("A" & r - 26).RowHeight = 35
      wF.Range("C" & r + 8).RowHeight = 35
      wF.Range("A" & r).RowHeight = 35
      Next i
As for the second inserted row to the eighth inserted row ... will remain empty
the previous table ends with border and the following table starts with border while these inserted rows left without borders.
Please have a look at the example in "Main File" to see what I mean. Thank you for your help
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 68741
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Insert rows at specific points

Post by HansV »

See if this works better:

Code: Select all

Sub test()
    Dim wM As Worksheet, wF As Worksheet, wS As Worksheet, m As Long, arrL As Variant, Data As String, Data2 As String, cnt As Long, clm As Variant
    Dim strRws() As String, Rws() As String, arrOut As Variant, r As Long, n As Long, c As Range, a As String, i As Long

    Application.ScreenUpdating = False

    Set wM = Worksheets("Main data")
    Set wF = Worksheets("Frst stage")
   ' Set wS = Worksheets("Second stage")
    m = wM.Range("A" & Rows.Count & "").End(xlUp).Row
    arrL = wM.Range("L1:L" & m).Value
    Data = "5"
    Data2 = "5"

    For cnt = 6 To m
        If arrL(cnt, 1) = "YES" Then
            Data = Data & " " & cnt
        Else
            Data2 = Data2 & " " & cnt
        End If
    Next cnt

    'First stage sheet
    clm = Array(5, 4, 6, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42)
    strRws = Split(Data)
    ReDim Rws(1 To UBound(strRws) + 1, 1 To 1)
    For cnt = 1 To UBound(strRws) + 1
        Rws(cnt, 1) = strRws(cnt - 1)
    Next cnt

    arrOut = Application.Index(wM.Cells, Rws, clm)
    wF.Activate
    wF.Range("6:" & wF.Rows.Count).Clear
    wF.Range("6:" & wF.Rows.Count).Delete
    m = UBound(arrOut, 1)

    With wF.Range("A5").Resize(UBound(arrOut, 1), UBound(arrOut, 2))
        .Value = arrOut
        .Sort Key1:=wF.Range("C5"), Header:=True
    End With

    n = Application.Ceiling(m / 25, 1)
    For i = n To 1 Step -1
        r = 6 + 25 * i
        wF.Range("A" & r).Resize(9).EntireRow.Insert
        wF.Range("C" & r).Value = "total amount"
        wF.Range("D" & r).Resize(1, 23).FormulaR1C1 = "=IF(SUM(R[-25]C:R[-1]C)=0,"""",SUM(R[-25]C:R[-1]C))"

        If i < n Then
            wF.Range("C" & r + 8).Value = "previous amount"
            wF.Range("D" & r + 8).Resize(1, 23).FormulaR1C1 = "=R[-8]C"
        End If

        wF.HPageBreaks.Add wF.Range("A" & r + 8)

        With wF.Range("A" & r - 26 & ":Z" & r)
            .Font.Name = "Times New Roman"
            .Font.Size = 15
            .Font.Bold = True
            .RowHeight = 23
            .Columns("D:Z").NumberFormat = "0.00"
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
        End With
    Next i

    For i = n To 1 Step -1
        r = 6 + 34 * i
        wF.Range("A" & r - 9).RowHeight = 35
        If i < n Then
            wF.Range("A" & r - 1).RowHeight = 35
        End If
    Next i

    wF.UsedRange.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub
Regards,
Hans

luis gaspper
Lounger
Posts: 25
Joined: 03 Aug 2020, 05:23

Re: Insert rows at specific points

Post by luis gaspper »

Thank you very much Mr. Hans
this version is more better than the previous.. but You seems to forgot the point of borders
another point to consider ... I tried to adjust these two lines to include the previous totals starting from the second table Until the last table but it didn't work properly with me ... Please press the F2 key in The cell D65 to see what I mean

Code: Select all

        wF.Range("D" & r).Resize(1, 23).FormulaR1C1 = "=IF(SUM(R[-25]C:R[-1]C)=0,"""",SUM(R[-25]C:R[-1]C))"
and

Code: Select all

        wF.Range("D" & r + 8).Resize(1, 23).FormulaR1C1 = "=R[-8]C"
Here's the attachment with desired results.Thanks a lot for your help.
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 68741
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Insert rows at specific points

Post by HansV »

How about

Code: Select all

Sub test()
    Dim wM As Worksheet, wF As Worksheet, wS As Worksheet, m As Long, arrL As Variant, Data As String, Data2 As String, cnt As Long, clm As Variant
    Dim strRws() As String, Rws() As String, arrOut As Variant, r As Long, n As Long, c As Range, a As String, i As Long

    Application.ScreenUpdating = False

    Set wM = Worksheets("Main data")
    Set wF = Worksheets("Frst stage")
   ' Set wS = Worksheets("Second stage")
    m = wM.Range("A" & Rows.Count & "").End(xlUp).Row
    arrL = wM.Range("L1:L" & m).Value
    Data = "5"
    Data2 = "5"

    For cnt = 6 To m
        If arrL(cnt, 1) = "YES" Then
            Data = Data & " " & cnt
        Else
            Data2 = Data2 & " " & cnt
        End If
    Next cnt

    'First stage sheet
    clm = Array(5, 4, 6, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42)
    strRws = Split(Data)
    ReDim Rws(1 To UBound(strRws) + 1, 1 To 1)
    For cnt = 1 To UBound(strRws) + 1
        Rws(cnt, 1) = strRws(cnt - 1)
    Next cnt

    arrOut = Application.Index(wM.Cells, Rws, clm)
    wF.Activate
    wF.Range("6:" & wF.Rows.Count).Clear
    wF.Range("6:" & wF.Rows.Count).Delete
    m = UBound(arrOut, 1)

    With wF.Range("A5").Resize(UBound(arrOut, 1), UBound(arrOut, 2))
        .Value = arrOut
        .Sort Key1:=wF.Range("C5"), Header:=True
    End With

    n = Application.Ceiling(m / 25, 1)
    For i = n To 1 Step -1
        r = 6 + 25 * i
        wF.Range("A" & r).Resize(9).EntireRow.Insert
        wF.Range("C" & r).Value = "total amount"
        wF.Range("D" & r).Resize(1, 23).FormulaR1C1 = "=IF(SUM(R[-26]C:R[-1]C)=0,"""",SUM(R[-26]C:R[-1]C))"

        If i < n Then
            wF.Range("C" & r + 8).Value = "previous amount"
            wF.Range("D" & r + 8).Resize(1, 23).FormulaR1C1 = "=R[-8]C"
        End If

        wF.HPageBreaks.Add wF.Range("A" & r + 8)

        With wF.Range("A" & r - 26 & ":Z" & r)
            .Font.Name = "Times New Roman"
            .Font.Size = 15
            .Font.Bold = True
            .RowHeight = 23
            .Columns("D:Z").NumberFormat = "0.00"
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlCenter
        End With
    Next i

    For i = n To 1 Step -1
        r = 6 + 34 * i
        wF.Range("A" & r - 9).RowHeight = 45
        wF.Range("A" & r - 34 & ":Z" & r - 9).Borders.LineStyle = xlContinuous
        If i < n Then
            wF.Range("A" & r - 1).RowHeight = 45
        End If
    Next i
    wF.UsedRange.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub
Regards,
Hans

luis gaspper
Lounger
Posts: 25
Joined: 03 Aug 2020, 05:23

Re: Insert rows at specific points

Post by luis gaspper »

Thank you very much Mr. Hans
Indeed! I have spent too much time in front of this part of the code that I can't even see the obvious anymore. I really lost my focus
maybe you need to change or modify this part of the code.

Code: Select all

    End With
    n = Application.Ceiling(m / 25, 1)
    For i = n To 1 Step -1
        r = 6 + 25 * i
        wF.Range("A" & r).Resize(9).EntireRow.Insert
        wF.Range("C" & r).Value = "total amount"
        wF.Range("D" & r).Resize(1, 23).FormulaR1C1 = "=IF(SUM(R[-26]C:R[-1]C)=0,"""",SUM(R[-26]C:R[-1]C))"

        If i < n Then
            wF.Range("C" & r + 8).Value = "previous amount"
            wF.Range("D" & r + 8).Resize(1, 23).FormulaR1C1 = "=R[-8]C"
        End If
Or maybe the picture shows the problem better.
The black arrow indicates the correct result ...As for the yellow column be given wrong results.
Or maybe you have another opinion ... Please accept my apologies for lost my focus...Again, thank you so much for all your time and help!
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 68741
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Insert rows at specific points

Post by HansV »

Ah, I see now. We have to loop forwards instead of backwards.

Code: Select all

Sub test()
    Dim wM As Worksheet, wF As Worksheet, wS As Worksheet, m As Long, arrL As Variant, Data As String, Data2 As String, cnt As Long, clm As Variant
    Dim strRws() As String, Rws() As String, arrOut As Variant, r As Long, n As Long, c As Range, a As String, i As Long

    Application.ScreenUpdating = False

    Set wM = Worksheets("Main data")
    Set wF = Worksheets("Frst stage")
   ' Set wS = Worksheets("Second stage")
    m = wM.Range("A" & Rows.Count & "").End(xlUp).Row
    arrL = wM.Range("L1:L" & m).Value
    Data = "5"
    Data2 = "5"

    For cnt = 6 To m
        If arrL(cnt, 1) = "YES" Then
            Data = Data & " " & cnt
        Else
            Data2 = Data2 & " " & cnt
        End If
    Next cnt

    'First stage sheet
    clm = Array(5, 4, 6, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42)
    strRws = Split(Data)
    ReDim Rws(1 To UBound(strRws) + 1, 1 To 1)
    For cnt = 1 To UBound(strRws) + 1
        Rws(cnt, 1) = strRws(cnt - 1)
    Next cnt

    arrOut = Application.Index(wM.Cells, Rws, clm)
    wF.Activate
    wF.Range("6:" & wF.Rows.Count).Clear
    wF.Range("6:" & wF.Rows.Count).Delete
    m = UBound(arrOut, 1)

    With wF.Range("A5").Resize(UBound(arrOut, 1), UBound(arrOut, 2))
        .Value = arrOut
        .Sort Key1:=wF.Range("C5"), Header:=True
    End With

    n = Application.Ceiling(m / 25, 1)
    r = 31
    For i = 1 To n
        wF.Range("A" & r).Resize(9).EntireRow.Insert
        wF.Range("C" & r).Value = "total amount"
        wF.Range("D" & r).Resize(1, 23).FormulaR1C1 = "=IF(SUM(R[-26]C:R[-1]C)=0,"""",SUM(R[-26]C:R[-1]C))"

        If i < n Then
            wF.Range("C" & r + 8).Value = "previous amount"
            wF.Range("D" & r + 8).Resize(1, 23).FormulaR1C1 = "=R[-8]C"
        End If

        wF.HPageBreaks.Add wF.Range("A" & r + 8)

        With wF.Range("A" & r - 26 & ":Z" & r)
            .Font.Name = "Times New Roman"
            .Font.Size = 15
            .Font.Bold = True
            .RowHeight = 23
            .Columns("D:Z").NumberFormat = "0.00"
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlCenter
        End With
        r = r + 34
    Next i

    For i = n To 1 Step -1
        r = 6 + 34 * i
        wF.Range("A" & r - 9).RowHeight = 45
        wF.Range("A" & r - 34 & ":Z" & r - 9).Borders.LineStyle = xlContinuous
        If i < n Then
            wF.Range("A" & r - 1).RowHeight = 45
        End If
    Next i
    wF.UsedRange.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub
Regards,
Hans

luis gaspper
Lounger
Posts: 25
Joined: 03 Aug 2020, 05:23

Re: Insert rows at specific points

Post by luis gaspper »

That's perfect Mr. Hans ...Thanking you for your insight. :cheers:
I will come back later .. Best Regards

luis gaspper
Lounger
Posts: 25
Joined: 03 Aug 2020, 05:23

Re: Insert rows at specific points

Post by luis gaspper »

Thank you very much Mr. Hans
I appreciate you taking the time to answer my questions
How can set Automatic setting of Print area of all the datas By including this code... I am using Excel 2010

Code: Select all

Sub SetupPrintout()
    Dim wsh As Worksheet
    Application.ScreenUpdating = False
    Application.PrintCommunication = False
    For Each wsh In Worksheets
        With wsh.PageSetup
            .LeftMargin = Application.CentimetersToPoints(0.6)
            .RightMargin = 0
            .TopMargin = Application.CentimetersToPoints(0.2)
            .BottomMargin = 0
            .HeaderMargin = 0
            .FooterMargin = 0
            .Orientation = xlPortrait
            .PaperSize = xlPaperA4
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With
    Next wsh
    Application.PrintCommunication = True
    Application.ScreenUpdating = True
End Sub
and finally I need to Alignment the main header in row 5 in Center So that it does not affect the rest of the rows?
Here's an attachment ... Once again many thanks for your effort.
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 68741
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Insert rows at specific points

Post by HansV »

You can call SetupPrintout at the end of your test macro.
And to center row 5 horizontally, insert the following line above Application.ScreenUpdating = True:

Code: Select all

    wF.Range("A5:Z5").HorizontalAlignment = xlCenter
Regards,
Hans

luis gaspper
Lounger
Posts: 25
Joined: 03 Aug 2020, 05:23

Re: Insert rows at specific points

Post by luis gaspper »

Thank you very much Mr. Hans ... I greatly appreciate your effort to help me.
last question please ... What if it was Print paper size Larger than the normal size
For example ...The paper size used ( 27.56in × 39.37in )
How can be customized from within the code above? Thank You so much .

User avatar
HansV
Administrator
Posts: 68741
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Insert rows at specific points

Post by HansV »

As far as I know, Excel VBA does not support custom paper sizes. You can set the paper size using

Code: Select all

wsh.PageSetup.PaperSize = ...
where ... is one of the constants of the xlPaperSize enumeration, see xlPaperSize.
If you set the default page size of your printer to 27.56in × 39.37in, you can use xlPaperUser:

Code: Select all

wsh.PageSetup.PaperSize = xlPaperUser
But you cannot define that size in VBA.
Regards,
Hans

luis gaspper
Lounger
Posts: 25
Joined: 03 Aug 2020, 05:23

Re: Insert rows at specific points

Post by luis gaspper »

That's great. Thank you very much Mr. Hans for your great help.
I can't express my happiness with this perfect and great illusatration
Best Regards