HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Insert variable number of rows

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
numberrowsvariableinsert

Problem

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  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

Solution

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  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  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 entire

Code Snippets

ws1 >> sourceSheet
ws2 >> destSheet
rngtocopy >> rngToCopy >> sourceRange
rngFinal >> destRange
LastRow >> lastRow
j >> lastSourceERow
z >> lastDestERow
k >> firstDestRow
x >> startRow
r >> destCell
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
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
Public Function LastRow(ws As Worksheet, column As Variant) As Long
    LastRow = ws.Cells(ws.Rows.Count, column).End(xlUp).Row
End Function

Context

StackExchange Code Review Q#67571, answer score: 4

Revisions (0)

No revisions yet.