patternMinor
Insert variable number of rows
Viewed 0 times
numberrowsvariableinsert
Problem
In the Excel vba sub below, I need to insert the number of rows equal to variable
So if
How can I improve this code?
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 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 subSolution
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
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
Sidenote: Replacing
Lastly, Sub and Function names should have Verb-Noun type names.
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.
Everything starts fine with the
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.
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
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 >> lastRowThe 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 >> destCellSidenote: 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 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
LoopEverything 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 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 SubRefactoring
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 entireCode Snippets
ws1 >> sourceSheet
ws2 >> destSheet
rngtocopy >> rngToCopy >> sourceRange
rngFinal >> destRange
LastRow >> lastRowj >> lastSourceERow
z >> lastDestERow
k >> firstDestRow
x >> startRow
r >> destCellDo 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
LoopOption 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 SubPublic Function LastRow(ws As Worksheet, column As Variant) As Long
LastRow = ws.Cells(ws.Rows.Count, column).End(xlUp).Row
End FunctionContext
StackExchange Code Review Q#67571, answer score: 4
Revisions (0)
No revisions yet.