VBA Clearing Contents of Last 20 Rows

[Allienne]

Hello!

I need to create a variable length report. I am able to get the code to work but I need to add 20 'blank' rows at the end of the data set for additional write in data. Now I can copy the last row 20 times but can't get how to clear those rows as I need the rows to have the borders.

If there is a way to just add borders to the first 20 lines under the last text that would work as well.

I will also need to somehow add thick borders from row 6 down to the bottom of the blank rows.

Any help would be greatly appreciated!

The code I used to 'copy' the last line 20 times is:

Dim LR1 As Long
    LR1 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR1).Copy
    Rows(LR1 + 1).Insert
    Dim LR2 As Long
    LR2 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR2).Copy
    Rows(LR2 + 1).Insert
    Dim LR3 As Long
    LR3 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR3).Copy
    Rows(LR3 + 1).Insert
    Dim LR4 As Long
    LR4 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR4).Copy
    Rows(LR4 + 1).Insert
    Dim LR5 As Long
    LR5 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR5).Copy
    Rows(LR5 + 1).Insert
    Dim LR6 As Long
    LR6 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR6).Copy
    Rows(LR6 + 1).Insert
    Dim LR7 As Long
    LR7 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR7).Copy
    Rows(LR7 + 1).Insert
    Dim LR8 As Long
    LR8 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR8).Copy
    Rows(LR8 + 1).Insert
    Dim LR9 As Long
    LR9 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR9).Copy
    Rows(LR9 + 1).Insert
    Dim LR10 As Long
    LR10 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR10).Copy
    Rows(LR10 + 1).Insert
    Dim LR11 As Long
    LR11 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR11).Copy
    Rows(LR11 + 1).Insert
    Dim LR12 As Long
    LR12 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR12).Copy
    Rows(LR12 + 1).Insert
    Dim LR13 As Long
    LR13 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR13).Copy
    Rows(LR13 + 1).Insert
    Dim LR14 As Long
    LR14 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR14).Copy
    Rows(LR14 + 1).Insert
    Dim LR15 As Long
    LR15 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR15).Copy
    Rows(LR15 + 1).Insert
    Dim LR16 As Long
    LR16 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR16).Copy
    Rows(LR16 + 1).Insert
    Dim LR17 As Long
    LR17 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR17).Copy
    Rows(LR17 + 1).Insert
    Dim LR18 As Long
    LR18 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR18).Copy
    Rows(LR18 + 1).Insert
    Dim LR19 As Long
    LR19 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR19).Copy
    Rows(LR19 + 1).Insert
    Dim LR20 As Long
    LR20 = Range("D" & Rows.Count).End(xlUp).Row
    Rows(LR20).Copy
    Rows(LR20 + 1).Insert

 

[mrmmickle1]

Maybe try something like this:

Sub Test()
    
    Dim LastRow As Long
    
    LastRow = Range("D" & Rows.Count).End(xlUp).Row
    
    Rows(LastRow + 1 & ":" & LastRow + 20).Borders.LineStyle = xlContinuous


End Sub

 

[Allienne]

Matt,

That worked to add the borders but is there a way to make to borders only go from Column A:U? If not, I can maybe delete the other columns to clear the borders.

Thanks!

 

[mrmmickle1]

Sure. Just make a slight modification:

Sub Test()
    
    Dim LastRow As Long
    
    LastRow = Range("D" & Rows.Count).End(xlUp).Row
    
    ActiveSheet.Range("A" & LastRow + 1 & ":U" & LastRow + 20).Borders.LineStyle = xlContinuous


End Sub

 

[Allienne]

Matt,

That worked perfectly!

Thank you so much!

 

[mrmmickle1]

You're quite welcome.