Insert rows at specific points
-
- StarLounger
- Posts: 68
- Joined: 03 Aug 2020, 05:23
Insert rows at specific points
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.
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.
-
- Administrator
- Posts: 78471
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Insert rows at specific points
Welcome to Eileen's Lounge!
I will take a look at it, but it might take a while.
I will take a look at it, but it might take a while.
Best wishes,
Hans
Hans
-
- Administrator
- Posts: 78471
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Insert rows at specific points
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?
Best wishes,
Hans
Hans
-
- StarLounger
- Posts: 68
- Joined: 03 Aug 2020, 05:23
Re: Insert rows at specific points
Thanks a lot Mr. Hans
Yes, that is correct I don't need for the signature rows
Yes, that is correct I don't need for the signature rows
-
- Administrator
- Posts: 78471
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Insert rows at specific points
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
Best wishes,
Hans
Hans
-
- StarLounger
- Posts: 68
- Joined: 03 Aug 2020, 05:23
Re: Insert rows at specific points
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.
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.
-
- Administrator
- Posts: 78471
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Insert rows at specific points
Insert the following lines above Next i:
Code: Select all
wF.Range("A" & r - 26).RowHeight = 45
wF.Range("A" & r).RowHeight = 45
Best wishes,
Hans
Hans
-
- StarLounger
- Posts: 68
- Joined: 03 Aug 2020, 05:23
Re: Insert rows at specific points
Thank you very much Mr. Hans
I have added this lines but the inserted rows changed to 45 points.
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
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
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.
-
- Administrator
- Posts: 78471
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Insert rows at specific points
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
Best wishes,
Hans
Hans
-
- StarLounger
- Posts: 68
- Joined: 03 Aug 2020, 05:23
Re: Insert rows at specific points
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
and
Here's the attachment with desired results.Thanks a lot for your help.
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))"
Code: Select all
wF.Range("D" & r + 8).Resize(1, 23).FormulaR1C1 = "=R[-8]C"
You do not have the required permissions to view the files attached to this post.
-
- Administrator
- Posts: 78471
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Insert rows at specific points
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
Best wishes,
Hans
Hans
-
- StarLounger
- Posts: 68
- Joined: 03 Aug 2020, 05:23
Re: Insert rows at specific points
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.
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!
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
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.
-
- Administrator
- Posts: 78471
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Insert rows at specific points
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
Best wishes,
Hans
Hans
-
- StarLounger
- Posts: 68
- Joined: 03 Aug 2020, 05:23
Re: Insert rows at specific points
That's perfect Mr. Hans ...Thanking you for your insight.
I will come back later .. Best Regards
I will come back later .. Best Regards
-
- StarLounger
- Posts: 68
- Joined: 03 Aug 2020, 05:23
Re: Insert rows at specific points
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
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.
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
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.
-
- Administrator
- Posts: 78471
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Insert rows at specific points
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:
And to center row 5 horizontally, insert the following line above Application.ScreenUpdating = True:
Code: Select all
wF.Range("A5:Z5").HorizontalAlignment = xlCenter
Best wishes,
Hans
Hans
-
- StarLounger
- Posts: 68
- Joined: 03 Aug 2020, 05:23
Re: Insert rows at specific points
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 .
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 .
-
- Administrator
- Posts: 78471
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Insert rows at specific points
As far as I know, Excel VBA does not support custom paper sizes. You can set the paper size using
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:
But you cannot define that size in VBA.
Code: Select all
wsh.PageSetup.PaperSize = ...
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
Best wishes,
Hans
Hans
-
- StarLounger
- Posts: 68
- Joined: 03 Aug 2020, 05:23
Re: Insert rows at specific points
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
I can't express my happiness with this perfect and great illusatration
Best Regards