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.
- Move the
If lastSourceERow check and the row insertion out of the loop.
- Reintroduce the
destRange variable with a new purpose.
- 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.
- Let's check the source sheet for data prior to doing anything else.
- Remove dead variables
startRow & lastDestERow and all related dead code.
- 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
