Select used rows within a Named Range? - excel

Question

I have an Excel Named Range called Schd_Preview which consists of cells F3:K500. Sometimes only 2 or 3 rows are used, sometimes 200 rows are used, sometimes all the rows are used. How do I copy only used rows within Schd_Preview within VBA?
Edit: I have data to the left of Schd_Preview in range B2:C12. Intersect() will not work with .UsedRange since it will include, at the very minimum, row 12 even if the named range only uses 2 rows.

Answer 1

Used Rows Within Range
NonCont and Cont refer to the used rows i.e. are they contiguous.
The first solution will not work if you have hidden used rows.
The Code
Option Explicit
Sub NonCont1() ' Values, formulas, formats.
Const PasteCell As String = "M3"
With Range(PasteCell)
.Resize(.Worksheet.Rows.Count - .Row + 1, _
Range("Schd_Preview").Columns.Count).Clear
End With
Dim rng As Range ' Copy Range
Set rng = Range("Schd_Preview").SpecialCells(xlCellTypeVisible)
rng.Copy Range(PasteCell) ' If you need values, then use 'PasteSpecial'.
' rng.Copy
' Range(PasteCell).PasteSpecial xlPasteValues
' Application.CutCopyMode = False
End Sub
Sub NonCont2() ' Values only.
Const PasteCell As String = "M3"
Const LastRowCol As Long = 1 ' in your case 1-6 (F-K).
Dim Data As Variant
Data = Range("Schd_Preview").Value
Dim UB2 As Long
UB2 = UBound(Data, 2)
Dim i As Long
Dim j As Long
Dim k As Long
For i = 1 To UBound(Data, 1)
If Data(i, LastRowCol) <> "" Then
k = k + 1
For j = 1 To UB2
Data(k, j) = Data(i, j)
Next j
End If
Next i
With Range(PasteCell)
.Resize(.Worksheet.Rows.Count - .Row + 1, UB2).Clear
Dim rng As Range ' Paste Range
Set rng = .Resize(k, UB2)
End With
rng.Value = Data
End Sub
' Surrounded by empty rows and columns.
Sub cont1()
Const PasteCell As String = "M3"
With Range(PasteCell)
.Resize(.Worksheet.Rows.Count - .Row + 1, _
Range("Schd_Preview").Columns.Count).Clear
End With
Dim rng As Range ' Copy Range
Set rng = Range("Schd_Preview").Cells(1).CurrentRegion
rng.Copy Range(PasteCell) ' Values, formulas, formats.
'Range(PasteCell).Resize(rng.Rows.Count, rng.Columns.Count).Value _
= rng.Value ' Values only.
End Sub
' Empty column to the right, and empty row at the bottom.
Sub cont2()
Const PasteCell As String = "M3"
With Range(PasteCell)
.Resize(.Worksheet.Rows.Count - .Row + 1, _
Range("Schd_Preview").Columns.Count).Clear
End With
Dim cel As Range
Set cel = Range("Schd_Preview").Cells(1)
Dim rng As Range ' Copy Range
Set rng = Range("Schd_Preview").Cells(1).CurrentRegion
With rng
Set rng = .Resize(.Rows.Count + .Row - cel.Row, _
.Columns.Count + .Column - cel.Column) _
.Offset(cel.Row - .Row, cel.Column - .Column)
End With
rng.Copy Range(PasteCell) ' Values, formulas, formats.
'Range(PasteCell).Resize(rng.Rows.Count, rng.Columns.Count).Value _
= rng.Value ' Values only.
End Sub
Sub cont3() ' Values only. It's a simplified 'NonCont2'.
Const PasteCell As String = "M3"
Const LastRowCol As Long = 1 ' in your case 1-6 (F-K).
Dim Data As Variant
Data = Range("Schd_Preview").Value
Dim UB2 As Long
UB2 = UBound(Data, 2)
Dim i As Long
For i = 1 To UBound(Data, 1)
If Data(i, LastRowCol) = "" Then
Exit For
End If
Next i
With Range(PasteCell)
.Resize(.Worksheet.Rows.Count - .Row + 1, UB2).Clear
Dim rng As Range ' Paste Range
Set rng = .Resize(i - 1, UB2)
End With
rng.Value = Data
End Sub