Insert variable number of rows

Question

In the Excel vba sub below, I need to insert the number of rows equal to variable j after row k.

So if j=17 and k=2 then I want 17 empty rows after row 2.

How can I improve this code?

sub stuck()
 Dim ws1 As Worksheet
 Dim ws2 As Worksheet
 Dim LastRow As Long
 Dim i As Long, z As Long
 Dim j As Long, k As Long, x As Long
 Dim rngtocopy As Range
 Dim rngFinal As Range
 Dim r As Range
 Set ws1 = Sheets("Calc")
 Set ws2 = Sheets("Dealer Orders")
 LastRow = ws1.Cells(ws1.Rows.Count, "E").End(xlUp).Row
 Set rngtocopy = ws1.Range("E2", ws1.Cells(LastRow, "F"))
 Set rngFinal = ws2.Range("K2", ws2.Cells(LastRow, "K"))
 j = ws1.Cells(ws1.Rows.Count, "E").End(xlUp).Row
 z = ws2.Cells(ws2.Rows.Count, "E").End(xlUp).Row
 k = 3
 x = 1
 Set r = Range("A" & k)
 Do While x < z
 With ws2
 If j > 0 Then
 ws2.Range(("A" & k), ws2.Range("A" & k).Offset(j, 0)).EntireRow.Insert
 Set r = Cells(r.Row + j, 1)
 For i = 2 To rngtocopy.Rows.Count
 With ws2.Range("K" & k)
 .Offset(0, 0).Value = rngtocopy(i, 1)
 .Offset(0, 1).Value = rngtocopy(i, 2)
 End With
 k = k + 1
 Next i
 End If
 k = k + 4
 End With
 x = x + 1
 Loop
 end sub

Answer 1

Readability

---

Naming

So, the first thing I would note is the poor naming. The way things are named right now makes it difficult to understand the code. So, to start, replace ws1 and ws2 with more meaningful names. The range variables are a little better, but could still use some improvement. I would also note that variables should be camelCased. These things simply make it easier to read the code.

ws1 >> sourceSheet
ws2 >> destSheet
rngtocopy >> rngToCopy >> sourceRange
rngFinal >> destRange
LastRow >> lastRow

The next thing to note is the abundance of single letter variable names. These are problematic. The only time you should use single letter variable names is for a loop counter. That's it. No exceptions. It is extremely difficult to map these letters to meanings while we're trying to understand logic. Will you remember what z is 6 months from now? I doubt it.

j >> lastSourceERow
z >> lastDestERow
k >> firstDestRow
x >> startRow
r >> destCell

Sidenote: Replacing r was a real PITA.

Lastly, Sub and Function names should have Verb-Noun type names. stuck() tells the dev using this code absolutely nothing. Perhaps CopyTheSmithReportRange() would be a good name.

WhiteSpace

Again, this is a readability thing. (I do promise to get around to a better way to do this, but first we do need to be able to read the code.)

You are indenting your code, which is good. I've seen worse, but it could be better. Indentation should visually tell me at what level we're currently working at. For example, consider this snippet.

Do While x < z
 With ws2
 If j > 0 Then
 ws2.Range(("A" & k), ws2.Range("A" & k).Offset(j, 0)).EntireRow.Insert
 Set r = Cells(r.Row + j, 1)
 For i = 2 To rngtocopy.Rows.Count
 With ws2.Range("K" & k)
 .Offset(0, 0).Value = rngtocopy(i, 1)
 .Offset(0, 1).Value = rngtocopy(i, 2)
 End With
 k = k + 1
 Next i
 End If
 k = k + 4
 End With
x = x + 1
Loop

Everything starts fine with the Do loop and the With statement, but then you add an extra level of indentation after inserting the row. The rest of that block is logically on the same level, so it should be at the same indentation level. Also take note that your loop incrememtation happens at the same indentation level as the For and Next statements. It shouldn't. It should be one level deeper.

The other thing to note about whitespace is the good use of vertical whitespace. It can make all the difference to readability. Use an extra line (one, never two) to differentiate between logically different things that occur sequentially at the same level of indentation.

This is the code after making these readability changes.

Option Explicit
Sub CopyTheSmithReportRange()
 Dim sourceSheet As Worksheet
 Dim destSheet As Worksheet
 Dim lastRow As Long
 Dim i As Long
 Dim lastDestERow As Long
 Dim lastSourceERow As Long
 Dim firstDestRow As Long
 Dim startRow As Long
 Dim sourceRange As Range
 Dim destRange As Range
 Dim destCell As Range
 firstDestRow = 3
 startRow = 1
 Set sourceSheet = Sheets("Calc")
 Set destSheet = Sheets("Dealer Orders")
 lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "E").End(xlUp).Row
 lastSourceERow = sourceSheet.Cells(sourceSheet.Rows.Count, "E").End(xlUp).Row
 lastDestERow = destSheet.Cells(destSheet.Rows.Count, "E").End(xlUp).Row
 Set sourceRange = sourceSheet.Range("E2", sourceSheet.Cells(lastRow, "F"))
 Set destRange = destSheet.Range("K2", destSheet.Cells(lastRow, "K"))
 
 Set destCell = Range("A" & firstDestRow)
 Do While startRow < lastDestERow
 
 With destSheet
 If lastSourceERow > 0 Then
 
 destSheet.Range(("A" & firstDestRow), destSheet.Range("A" & firstDestRow).Offset(lastSourceERow, 0)).EntireRow.Insert
 Set destCell = Cells(r.Row + lastSourceERow, 1)
 For i = 2 To sourceRange.Rows.Count
 
 With destSheet.Range("K" & firstDestRow)
 .Offset(0, 0).Value = sourceRange(i, 1)
 .Offset(0, 1).Value = sourceRange(i, 2)
 End With
 
 firstDestRow = firstDestRow + 1
 Next i
 
 End If
 
 firstDestRow = firstDestRow + 4
 End With
 
 startRow = startRow + 1
 Loop
End Sub

---

Refactoring

The first thing I notice is that there are a lot of similar variables declared and that the code is deeply nested. These are indications that the code is doing too much and is in violation of the Single Responsibility Principle. It will be our goal now to simplify the code.

There's a quick hit right at the beginning. There is no difference between lastSourceERow and lastRow. We can get rid of lastRow entirely. While we're at it, let's go ahead and extract a function for lastRow. You'll find yourself needing it a lot if you continue to write vba code.

Public Function LastRow(ws As Worksheet, column As Variant) As Long
 LastRow = ws.Cells(ws.Rows.Count, column).End(xlUp).Row
End Function

Note that this function will take input of either a column name ("E") or integer index, so we could pass it the integer index if we so chose.

This simplifies variable initialization a bit, and we have one less declaration.

lastSourceERow = LastRow(sourceSheet, "E")
lastDestERow = LastRow(destSheet, "E")
Set sourceRange = sourceSheet.Range("E2", sourceSheet.Cells(lastSourceERow, "F"))
Set destRange = destSheet.Range("K2", destSheet.Cells(lastSourceERow, "K"))

Setting the ranges leaves a little to be desired though, so we'll use a bit of a hack to clean up those lines. Let's just concatenate the last row to a string indicating the ranges we want to work with.

Set sourceRange = sourceSheet.Range("E2:F" & lastSourceERow)
Set destRange = destSheet.Range("K2:K" & lastSourceERow)

Lets use a similar trick to replace this obtuse line.

destSheet.Range(("A" & firstDestRow), destSheet.Range("A" & firstDestRow).Offset(lastSourceERow, 0)).EntireRow.Insert

With this

destSheet.Range("A" & firstDestRow & ":A" & lastSourceERow).EntireRow.Insert 

I'm honestly not a fan of concatenating cell addresses like this, but I think it does a world of good to the readability and maintainability of this code. While we're at it, I think this is useful enough to extract into it's own subroutine.

Public Sub InsertRows(ws As Worksheet, firstRow As Long, lastRow As Long)
 ws.Range("A" & firstRow & ":A" & lastRow).EntireRow.Insert
End Sub

Let's also remove the With destSheet. It's not serving much of a purpose other than to further nest the code. Let's also remove destRange as it's not being used at all. That brings us to here, which is getting somewhere.

Sub CopyTheSmithReportRange()
 Dim sourceSheet As Worksheet
 Dim destSheet As Worksheet
 Dim i As Long
 Dim lastDestERow As Long
 Dim lastSourceERow As Long
 Dim firstDestRow As Long
 Dim startRow As Long
 Dim sourceRange As Range
 Dim destCell As Range
 Set sourceSheet = Sheets("Calc")
 Set destSheet = Sheets("Dealer Orders")
 lastSourceERow = LastRow(sourceSheet, "E")
 lastDestERow = LastRow(destSheet, "E")
 Set sourceRange = sourceSheet.Range("E2:F" & lastSourceERow)
 firstDestRow = 3
 startRow = 1
 Set destCell = Range("A" & firstDestRow)
 Do While startRow < lastDestERow
 If lastSourceERow > 0 Then
 InsertRows destSheet, firstDestRow, lastSourceERow
 Set destCell = destSheet.Cells(destCell.Row + lastSourceERow, 1)
 For i = 2 To sourceRange.Rows.Count
 With destSheet.Range("K" & firstDestRow)
 .Offset(0, 0).Value = sourceRange(i, 1)
 .Offset(0, 1).Value = sourceRange(i, 2)
 End With
 firstDestRow = firstDestRow + 1
 Next i
 End If
 firstDestRow = firstDestRow + 4
 startRow = startRow + 1
 Loop
End Sub

But not quite there yet....

---

Now, instead of this Do While loop, let's iterate through a range of cells with a ForEach loop instead. But first, remove this line, it is also dead code.

 Set destCell = destSheet.Cells(destCell.Row + lastSourceERow, 1)

Actually, completely remove this variable. It's not actually used anywhere. Okay, now let's replace that do loop with a foreach.

Sub CopyTheSmithReportRange()
 Dim sourceSheet As Worksheet
 Dim destSheet As Worksheet
 Dim lastDestERow As Long
 Dim lastSourceERow As Long
 Dim firstDestRow As Long
 Dim startRow As Long
 Dim sourceRange As Range
 Set sourceSheet = Sheets("Calc")
 Set destSheet = Sheets("Dealer Orders")
 lastSourceERow = LastRow(sourceSheet, "E")
 lastDestERow = LastRow(destSheet, "E")
 Set sourceRange = sourceSheet.Range("E2:F" & lastSourceERow)
 firstDestRow = 3
 startRow = 1
 If lastSourceERow > 0 Then
 InsertRows destSheet, firstDestRow, lastSourceERow
 
 Dim destRange As Range
 Set destRange = Range("K3:K" & lastSourceERow)
 
 Dim cell As Range, i As Long
 i = 2
 
 For Each cell In destRange
 
 cell.Value = sourceRange(i, 1)
 cell.Offset(0, 1).Value = sourceRange(i, 2)
 
 i = i + 1
 Next cell
 
 End If
End Sub

A lot just happened there, so let me explain.

1. Move the If lastSourceERow check and the row insertion out of the loop.
2. Reintroduce the destRange variable with a new purpose.
3. Write the values to the iterator cell range, instead of offsetting based on some counter variables.

Now there's just a little more clean up to do.

1. Let's check the source sheet for data prior to doing anything else.
2. Remove dead variables startRow & lastDestERow and all related dead code.
3. Change firstDestRow from a variable to a constant, it's value no longer changes.

And we now have a subroutine that fits on a single screen without scrolling. We could probably extract another method, but this is good enough for me. The code below does exactly the same thing your original did.

Sub CopyTheSmithReportRange()
 Dim sourceSheet As Worksheet
 Dim destSheet As Worksheet
 Dim lastSourceERow As Long
 Dim sourceRange As Range
 
 Const firstDestRow As Long = 3
 Set sourceSheet = Sheets("Calc")
 Set destSheet = Sheets("Dealer Orders")
 lastSourceERow = LastRow(sourceSheet, "E")
 If lastSourceERow > 0 Then
 Set sourceRange = sourceSheet.Range("E2:F" & lastSourceERow)
 InsertRows destSheet, firstDestRow, lastSourceERow
 
 Dim destRange As Range
 Set destRange = Range("K3:K" & lastSourceERow)
 
 Dim cell As Range, i As Long
 i = 2
 For Each cell In destRange
 
 cell.Value = sourceRange(i, 1)
 cell.Offset(0, 1).Value = sourceRange(i, 2)
 
 i = i + 1
 Next cell
 
 End If
End Sub

• James Snell: Wherever you do a Set you should always set it to Nothing later in VBA. I've seen a couple of issues catch people out where they haven't done that.
• RubberDuck: @JamesSnell my answer is as complete as it's going to be, but I'd be greatful if you stopped by chat to tell me how you feel about When do you need to set objects to nothing?.
• user28366: ++ too much time on hands :? hehe well done. btw is this If lastSourceERow > 0 Then really necessary ?
• RubberDuck: Now that you mention it @vba4all, I don't think it is. I'm pretty sure the lastRow function will return a 1 if there are no used cells. In fact, I'm positive that Cells.End(xlUp).Row will return a 1 for an unused range. Good catch.
• RubberDuck: You're welcome! I figured as much (and we've all been there), so I tried to explain the thought process I used to clean it up, rather than throw an alternate implementation at you. I hope it helped.