VBA code for indeterminate ranges containing blank rows

jardenp

Active Member
Joined
May 12, 2009
Messages
373
Office Version
  1. 2019
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows
I have "entries" that consist of a row of data and then a blank row below. The first entry is in A2:K3. The number of entries is indeterminate. I have formatting (borders and such) that I want to copy from the first to all the other entries--A4:K5, A6:K7, etc.

My modified code from the macro recorder is:
Code:
'Copy Box Format to Remainder of Entries
    Range("A2:K3").Select
        Selection.Copy
    Range("A2:K43").Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
I normally would use something along the lines
Code:
Range("A2:K" & Range("A2").End(xlDown).Row).Select
to replace
Code:
Range("A2:K43").Select
but I get an error. I suspect because the data cells in column A aren't contiguous.

Any thoughts?
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Try using xlUp instead of down. (and you don't need to select the range to work with it.) ie.
Code:
Range("A2:K3").Copy
Range("A2:K" & Cells(Rows.Count, "A").End(xlUp).Row).PasteSpecial Paste:=xlFormats, Operation:=xlNone, _
  SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Does that help?

BTW, your original code (the xlDown) did not give me an error, it just selected rows 2:4, which is the expected result for your data layout. (but I suspect not what you're looking to do.)
 
Upvote 0
I apologize: I misspoke (or mistyped?). I didn't mean "error," just that it didn't do what I wanted.

Your code works great. Thank you.

The only problem is that the bottom border on the last entry doesn't transfer. It's not really a "problem," but would you know how to fix that?

The formatting I applied earlier in the code is:
Code:
'Format Line Boxes
    Range("A2:K3").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    
    'Underline Data
    Range("A2:J2").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
Thanks! (And if you're an Alaskan who fishes, I'm jealous!)
 
Upvote 0

Forum statistics

Threads
1,217,763
Messages
6,138,459
Members
450,140
Latest member
myexcel202424

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top