Inserting Rows with For Loops

J

johnpalf

New Member
Joined
May 27, 2014
Messages
25
I'm writing code to copy rows and then insert copies of the same rows below. The numer of times it should copy and paste those rows is defined as Unit 1-7. After each for loop, I would like the code to insert a different row that sepeates each block. Please see the code below. The bold italic portion is what I need help with. The SOR row is not copying/pasting in.

'define number of catalysts used
Range("D7").Select
c = ActiveCell.Value
m = c
NameofSheet = ActiveSheet.Name
'Naming each row and expected number of units
'Each name corresponds to a row based on the cat. and the loading method

Dim Cat1 As Range
Set Cat1 = Rows(15)
Dim Cat2 As Range
Set Cat2 = Rows(16)
Dim Cat3 As Range
Set Cat3 = Rows(17)
Dim Cat4 As Range
Set Cat4 = Rows(18)
Dim Cat5 As Range
Set Cat5 = Rows(19)
Dim Cat6 As Range
Set Cat6 = Rows(20)
Dim Cat7 As Range
Set Cat7 = Rows(21)
Dim SOR As Range
Set SOR = Rows(29)

Unit1 = Application.RoundUp(Sheets(NameofSheet).Range("K4") / 10, 0) - 1
Unit2 = Application.RoundUp(Sheets(NameofSheet).Range("K5") / 10, 0) - 1
Unit3 = Application.RoundUp(Sheets(NameofSheet).Range("K6") / 10, 0) - 1
Unit4 = Application.RoundUp(Sheets(NameofSheet).Range("K7") / 10, 0) - 1
Unit5 = Application.RoundUp(Sheets(NameofSheet).Range("K8") / 10, 0) - 1
Unit6 = Application.RoundUp(Sheets(NameofSheet).Range("K9") / 10, 0) - 1
Unit7 = Application.RoundUp(Sheets(NameofSheet).Range("K10") / 10, 0) - 1

'The units are defined correctly. To prove to yourself, uncomment the following block of code.
Range("C50").Select
SOR.Select
Selection.Copy
Selection.Insert Shift:=xlDown

Range("C15").Select 'set active cell to first catalyst
For j = 1 To Unit1 'loops for each row that needs to be created
Cat1.Select
Selection.Copy
Selection.Insert Shift:=xlDown
Next j
SOR.Select
Selection.Copy
Selection.Insert Shift:=xlDown

For j = 1 To Unit2
Cat2.Select
Selection.Copy
Selection.Insert Shift:=xlDown
Next j
SOR.Select
Selection.Copy
Selection.Insert Shift:=xlDown
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Sort by date Sort by votes
Hi there,

I'm not sure why but I think there's a part of the code that is missing.

Am i correct ?
 
Upvote 0
Below, I'vecopied the entire sub.
Code: 
Sub AddLoadingSheet()

Dim n As Integer
Dim b As Integer
Range("D5").Select
b = ActiveCell.Value 'number of beds
NameofSheet = ActiveSheet.Name
n = b
'defining variables
        
        CatalystBed1 = Sheets(NameofSheet).Range("B11:C20").Value
        CatalystBed2 = Sheets(NameofSheet).Range("B24:C33").Value
        CatalystBed3 = Sheets(NameofSheet).Range("B37:C46").Value
        CatalystBed4 = Sheets(NameofSheet).Range("B50:C59").Value
        CatalystBed5 = Sheets(NameofSheet).Range("B63:C72").Value
        CatalystBed6 = Sheets(NameofSheet).Range("B76:C85").Value
        CatalystBed7 = Sheets(NameofSheet).Range("B89:C98").Value
        
        Depth1 = Sheets(NameofSheet).Range("G10:G20").Value
        Depth2 = Sheets(NameofSheet).Range("G23:G33").Value
        Depth3 = Sheets(NameofSheet).Range("G36:G46").Value
        Depth4 = Sheets(NameofSheet).Range("G49:G59").Value
        Depth5 = Sheets(NameofSheet).Range("G62:G72").Value
        Depth6 = Sheets(NameofSheet).Range("G75:G85").Value
        Depth7 = Sheets(NameofSheet).Range("G88:G98").Value
         
        Range("L2").Select
        ID = ActiveCell.Value
'create new loading sheets for each bed and paste variables defined above
'the variables defined above are catalyst, loading style, and loaded depth
For i = 1 To b
Sheets("Loading Sheet").Copy After:=ActiveWorkbook.Sheets(NameofSheet)
    ActiveSheet.Name = NameofSheet & " - Bed " & n
    LoadingSheetName = ActiveSheet.Name
    Range("C5").Select
    ActiveCell.Value = "Reactor " & NameofSheet
    ActiveCell.Offset(1, 0).Value = "Bed " & n
    ActiveCell.Offset(4, 0).Value = ID
    
    
     If n = 7 Then
    
        Range("C15:D24").Value = CatalystBed7
        Range("Q14:Q24").Value = Depth7 'LQTS added this 2nd line after each if/elseif
    
        ElseIf n = 6 Then
        Range("C15:D24").Value = CatalystBed6
        Range("Q14:Q24").Value = Depth6
        
        ElseIf n = 5 Then
        Range("C15:D24").Value = CatalystBed5
        Range("Q14:Q24").Value = Depth5
        
        ElseIf n = 4 Then
        Range("C15:D24").Value = CatalystBed4
        Range("Q14:Q24").Value = Depth4
        
        ElseIf n = 3 Then
        Range("C15:D24").Value = CatalystBed3
        Range("Q14:Q24").Value = Depth3
        
        ElseIf n = 2 Then
        Range("C15:D24").Value = CatalystBed2
        Range("Q14:Q24").Value = Depth2
        
        ElseIf n = 1 Then
        Range("C15:D24").Value = CatalystBed1
        Range("Q14:Q24").Value = Depth1
        
        End If
        
         With ActiveSheet
            .AutoFilterMode = False
            With Range("c1", Range("c" & Rows.Count).End(xlUp))
                .AutoFilter 1, "*(blank)*"
                On Error Resume Next
                .Offset(1).SpecialCells(12).EntireRow.Delete
            End With
            .AutoFilterMode = False
        End With
        
        'Copy and paste the values from below above
        MoveCatalyst = Range("C15:D21").Value
        Range("E4:F10") = MoveCatalyst
        MoveDepth = Range("Q15:Q21").Value
        Range("L4:L10") = MoveDepth
        
        
    n = n - 1
Next i
'LQTS added the following code to automate creation of new rows
'for the convenience of the user
'define number of catalysts used
Range("D7").Select
c = ActiveCell.Value
m = c
NameofSheet = ActiveSheet.Name
'Naming each row and expected number of units
'Each name corresponds to a row based on the cat. and the loading method
    
    Dim Cat1 As Range
    Set Cat1 = Rows(15)
    Dim Cat2 As Range
    Set Cat2 = Rows(16)
    Dim Cat3 As Range
    Set Cat3 = Rows(17)
    Dim Cat4 As Range
    Set Cat4 = Rows(18)
    Dim Cat5 As Range
    Set Cat5 = Rows(19)
    Dim Cat6 As Range
    Set Cat6 = Rows(20)
    Dim Cat7 As Range
    Set Cat7 = Rows(21)
    Dim SOR As Range
    Set SOR = Rows(29)
    
    Unit1 = Application.RoundUp(Sheets(NameofSheet).Range("K4") / 10, 0) - 1
    Unit2 = Application.RoundUp(Sheets(NameofSheet).Range("K5") / 10, 0) - 1
    Unit3 = Application.RoundUp(Sheets(NameofSheet).Range("K6") / 10, 0) - 1
    Unit4 = Application.RoundUp(Sheets(NameofSheet).Range("K7") / 10, 0) - 1
    Unit5 = Application.RoundUp(Sheets(NameofSheet).Range("K8") / 10, 0) - 1
    Unit6 = Application.RoundUp(Sheets(NameofSheet).Range("K9") / 10, 0) - 1
    Unit7 = Application.RoundUp(Sheets(NameofSheet).Range("K10") / 10, 0) - 1
        
Range("C15").Select 'set active cell to first catalyst
    For j = 1 To Unit1 'loops for each row that needs to be created
    Cat1.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
    
    For j = 1 To Unit2
    Cat2.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
   
    For j = 1 To Unit3
    Cat3.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
    
    For j = 1 To Unit4
    Cat4.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
    
    For j = 1 To Unit5
    Cat5.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
    
    For j = 1 To Unit6
    Cat6.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
    
    For j = 1 To Unit7
    Cat7.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
    
    'Rows("15:15").Select
    'Selection.Copy
    'Rows("16:16").Select
    'Selection.Insert Shift:=xlDown
    'Rows("15:15").Select
    'Application.CutCopyMode = False
    'Selection.Copy
    'Rows("17:17").Select
    'ActiveSheet.Paste

End Sub
 
Upvote 0
You are copying but never pasting.
 
Upvote 0
Selection.Insert Shift:=xlDown is working to paste (insert) the varibles Cat 1-7, but when I had it doing the same for 'SOR' (in my first post, but subsequently deleted in my second) the SOR variable didn't get inserted (or pasted). Is pasting preferable to inserting if I want it to paste onto a row below without deleting the row below?
 
Upvote 0
Sorry I'm a little confused.

You set SOR in the sub you posted but apart from that you don't seem to do anything with it.
 
Upvote 0
Sorry, that was confusing. In my first post I did. It's bold italic. Since yesterday, I had deleted it, so when I posted in my entire sub it was gone. I'll now post it all again with SOR (meaning to insert it as I did Cat 1-7) again. Thanks for your patience.

Code: 
Sub AddLoadingSheet() 

Dim n As Integer
Dim b As Integer
Range("D5").Select
b = ActiveCell.Value 'number of beds
NameofSheet = ActiveSheet.Name
n = b
'defining variables
        
        CatalystBed1 = Sheets(NameofSheet).Range("B11:C20").Value
        CatalystBed2 = Sheets(NameofSheet).Range("B24:C33").Value
        CatalystBed3 = Sheets(NameofSheet).Range("B37:C46").Value
        CatalystBed4 = Sheets(NameofSheet).Range("B50:C59").Value
        CatalystBed5 = Sheets(NameofSheet).Range("B63:C72").Value
        CatalystBed6 = Sheets(NameofSheet).Range("B76:C85").Value
        CatalystBed7 = Sheets(NameofSheet).Range("B89:C98").Value
        
        Depth1 = Sheets(NameofSheet).Range("G10:G20").Value
        Depth2 = Sheets(NameofSheet).Range("G23:G33").Value
        Depth3 = Sheets(NameofSheet).Range("G36:G46").Value
        Depth4 = Sheets(NameofSheet).Range("G49:G59").Value
        Depth5 = Sheets(NameofSheet).Range("G62:G72").Value
        Depth6 = Sheets(NameofSheet).Range("G75:G85").Value
        Depth7 = Sheets(NameofSheet).Range("G88:G98").Value
         
        Range("L2").Select
        ID = ActiveCell.Value
'create new loading sheets for each bed and paste variables defined above
'the variables defined above are catalyst, loading style, and loaded depth
For i = 1 To b
        
    Sheets("Loading Sheet").Copy After:=ActiveWorkbook.Sheets(NameofSheet)
    ActiveSheet.Name = NameofSheet & " - Bed " & n
    LoadingSheetName = ActiveSheet.Name
    Range("C5").Select
    ActiveCell.Value = "Reactor " & NameofSheet
    ActiveCell.Offset(1, 0).Value = "Bed " & n
    ActiveCell.Offset(4, 0).Value = ID
    
    
     If n = 7 Then
    
        Range("C15:D24").Value = CatalystBed7
        Range("Q14:Q24").Value = Depth7 'LQTS added this 2nd line after each if/elseif
    
        ElseIf n = 6 Then
        Range("C15:D24").Value = CatalystBed6
        Range("Q14:Q24").Value = Depth6
        
        ElseIf n = 5 Then
        Range("C15:D24").Value = CatalystBed5
        Range("Q14:Q24").Value = Depth5
        
        ElseIf n = 4 Then
        Range("C15:D24").Value = CatalystBed4
        Range("Q14:Q24").Value = Depth4
        
        ElseIf n = 3 Then
        Range("C15:D24").Value = CatalystBed3
        Range("Q14:Q24").Value = Depth3
        
        ElseIf n = 2 Then
        Range("C15:D24").Value = CatalystBed2
        Range("Q14:Q24").Value = Depth2
        
        ElseIf n = 1 Then
        Range("C15:D24").Value = CatalystBed1
        Range("Q14:Q24").Value = Depth1
        
        End If
        
         With ActiveSheet
            .AutoFilterMode = False
            With Range("c1", Range("c" & Rows.Count).End(xlUp))
                .AutoFilter 1, "*(blank)*"
                On Error Resume Next
                .Offset(1).SpecialCells(12).EntireRow.Delete
            End With
            .AutoFilterMode = False
        End With
        
        'Copy and paste the values from below above
        MoveCatalyst = Range("C15:D21").Value
        Range("E4:F10") = MoveCatalyst
        MoveDepth = Range("Q15:Q21").Value
        Range("L4:L10") = MoveDepth
        'clear contents of depth loaded in column Q
        Range("Q11:Q24").Select
        Selection.ClearContents
        
        
    n = n - 1
Next i
'LQTS added the following code to automate creation of new rows
'for the convenience of the user
'define number of catalysts used
Range("D7").Select
c = ActiveCell.Value
m = c
NameofSheet = ActiveSheet.Name
'Naming each row and expected number of units
'Each name corresponds to a row based on the cat. and the loading method
    
    Dim Cat1 As Range
    Set Cat1 = Rows(15)
    Dim Cat2 As Range
    Set Cat2 = Rows(16)
    Dim Cat3 As Range
    Set Cat3 = Rows(17)
    Dim Cat4 As Range
    Set Cat4 = Rows(18)
    Dim Cat5 As Range
    Set Cat5 = Rows(19)
    Dim Cat6 As Range
    Set Cat6 = Rows(20)
    Dim Cat7 As Range
    Set Cat7 = Rows(21)
    Dim SOR As Range
    Set SOR = Rows(29)
    
    Unit1 = Application.RoundUp(Sheets(NameofSheet).Range("K4") / 10, 0) - 1
    Unit2 = Application.RoundUp(Sheets(NameofSheet).Range("K5") / 10, 0) - 1
    Unit3 = Application.RoundUp(Sheets(NameofSheet).Range("K6") / 10, 0) - 1
    Unit4 = Application.RoundUp(Sheets(NameofSheet).Range("K7") / 10, 0) - 1
    Unit5 = Application.RoundUp(Sheets(NameofSheet).Range("K8") / 10, 0) - 1
    Unit6 = Application.RoundUp(Sheets(NameofSheet).Range("K9") / 10, 0) - 1
    Unit7 = Application.RoundUp(Sheets(NameofSheet).Range("K10") / 10, 0) - 1
        
Range("C15").Select 'set active cell to first catalyst
    For j = 1 To Unit1 'loops for each row that needs to be created
    Cat1.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
    [B][I]SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown[/I] [/B]
    For j = 1 To Unit2
    Cat2.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
   [B][I]SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown[/I] [/B]
    For j = 1 To Unit3
    Cat3.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
    [B][I]SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown[/I] [/B]
    For j = 1 To Unit4
    Cat4.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
    [B][I]SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown[/I] [/B]
    For j = 1 To Unit5
    Cat5.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
    [B][I]SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown[/I] [/B]
    For j = 1 To Unit6
    Cat6.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
    SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown 
   
    For j = 1 To Unit7
    Cat7.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Next j
    [B][I]SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown[/I] [/B]
    'Rows("15:15").Select
    'Selection.Copy
    'Rows("16:16").Select
    'Selection.Insert Shift:=xlDown
    'Rows("15:15").Select
    'Application.CutCopyMode = False
    'Selection.Copy
    'Rows("17:17").Select
    'ActiveSheet.Paste

End Sub
 
Upvote 0
I can't see why the code doesn't work for SOR.

Have you tried stepping through the code with F8 to see what's happening?

PS All this inserting/copying could probably be done without all the looping.
 
Upvote 0
The row numbers change when other rows are getting inserted. So since SOR is defined as a Range that is Row(x), when Row x is later blank, it copies and pastes a blank row. Is there a way to copy a row and save it to be pasted later without having it be dependent on what's in that row at the time of pasting? I have Dim SOR As Range. Should the Dim be something else?
 
Last edited:
Upvote 0
You should re-order the code.

Perhaps something like this.
Code: 
Dim Cat1 As Range
Dim Cat2 As Range
Dim Cat3 As Range
Dim Cat4 As Range
Dim Cat5 As Range
Dim Cat6 As Range
Dim Cat7 As Range
Dim SOR As Range

    Unit1 = Application.RoundUp(Sheets(NameofSheet).Range("K4") / 10, 0) - 1
    Unit2 = Application.RoundUp(Sheets(NameofSheet).Range("K5") / 10, 0) - 1
    Unit3 = Application.RoundUp(Sheets(NameofSheet).Range("K6") / 10, 0) - 1
    Unit4 = Application.RoundUp(Sheets(NameofSheet).Range("K7") / 10, 0) - 1
    Unit5 = Application.RoundUp(Sheets(NameofSheet).Range("K8") / 10, 0) - 1
    Unit6 = Application.RoundUp(Sheets(NameofSheet).Range("K9") / 10, 0) - 1
    Unit7 = Application.RoundUp(Sheets(NameofSheet).Range("K10") / 10, 0) - 1

    Set Cat1 = Rows(15)
    For j = 1 To Unit1    'loops for each row that needs to be created
        Cat1.Select
        Selection.Copy
        Selection.Insert Shift:=xlDown
    Next j

    Set SOR = Rows(29)
    SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown

    Set Cat2 = Rows(16)
    For j = 1 To Unit2
        Cat2.Select
        Selection.Copy
        Selection.Insert Shift:=xlDown
    Next j

    Set SOR = Rows(29)
    SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown

    Set Cat3 = Rows(17)
    For j = 1 To Unit3
        Cat3.Select
        Selection.Copy
        Selection.Insert Shift:=xlDown
    Next j

    Set SOR = Rows(29)
    SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown

    Set Cat3 = Rows(18)
    For j = 1 To Unit4
        Cat4.Select
        Selection.Copy
        Selection.Insert Shift:=xlDown
    Next j

    Set SOR = Rows(29)
    SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Set Cat3 = Rows(19)

    For j = 1 To Unit5
        Cat5.Select
        Selection.Copy
        Selection.Insert Shift:=xlDown
    Next j

    Set SOR = Rows(29)
    SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Set Cat3 = Rows(20)

    For j = 1 To Unit6
        Cat6.Select
        Selection.Copy
        Selection.Insert Shift:=xlDown
    Next j

    Set SOR = Rows(29)
    SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Set Cat3 = Rows(21)

    For j = 1 To Unit7
        Cat7.Select
        Selection.Copy
        Selection.Insert Shift:=xlDown
    Next j

    Set SOR = Rows(29)
    SOR.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown

By the way, if you're interested this is how it might look if you used a loop.
Code: 
Dim Cat As Range
Dim SOR As Range
Dim Unit As Variant

    For I = 15 To 21

        Unit = Application.RoundUp(Sheets(NameofSheet).Range("K" & I - 11) / 10, 0) - 1

        Set Cat = Rows(I)


        For j = 1 To Unit    'loops for each row that needs to be created
            Cat.Select
            Selection.Copy
            Selection.Insert Shift:=xlDown
        Next j

        Set SOR = Rows(29)
        SOR.Select
        Selection.Copy
        Selection.Insert Shift:=xlDown

    Next I
 
Upvote 0
You must log in or register to reply here.

Similar threads

Livin404
  • Question Question
Adjust height of row(s) using VBA
Replies
1
Views
249
rlv01
R
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
239
rlv01
R
S
  • Solved
Move row based on cell color
Replies
3
Views
326
jolivanes
jolivanes
N
  • Question Question
VBA - Intersect code being re-initiated
Replies
1
Views
180
Peter_SSs
Peter_SSs
B
  • Solved
Find last row of data in cell A that is a part of a table
Replies
9
Views
728
Alex Blakenburg
A

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top