Visit my Youtube Channel
Select Dataset Except For Top Row
Note: This webpage is designed to accompany the Youtube video posted above. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the code presented in the video.
Each code block covered in the video is given below.
We are going to look at a very specific requirement. How to dynamically select a full dataset except for the top row i.e. minus the Header row? In other words, we want to select just the Data Body of a Data Range. The answer is not as straightforward as you would expect. Never-the-less it is a fun piece of code and its handy to know when pasting data one below the other. So, we will first, build out the solution and then, look at a few practical examples.
Build The Code
Sub RangeResizeOffset()
Dim rng As Range
Set rng = wsIn.Range("A1").CurrentRegion
'Syntax: expression.Offset (RowOffset, ColumnOffset)
Set rng = rng.Offset(1)
'Syntax: expression.Resize (RowSize, ColumnSize)
Set rng = rng.Resize(rng.Rows.Count - 1)
rng.Select
'Dim rng As Range
'Set rng = wsIn.Range("A1").CurrentRegion.Offset(1) _
' .Resize(wsIn.Range("A1").CurrentRegion.Rows.Count - 1)
'rng.Select
End Sub
Example: Basic Copy
Sub CopyRangeMinusHeader()
wsOut.Rows("2:" & wsOut.Rows.Count).Clear
wsIn.Range("A1").CurrentRegion.Offset(1) _
.Resize(wsIn.Range("A1").CurrentRegion.Rows.Count - 1) _
.Copy wsOut.Range("A2")
End Sub
Example: Merge Files
Option Explicit
Public Const folderPath = "C:\Youtube\Current\04 Merge and Split Reports\Demo\Invoices"
Sub MergeFiles()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
wsOut.Cells.Clear
Dim lrow As Long
Dim wb As Workbook
Dim fileCount As Long
fileCount = 0
Dim fileName As String
fileName = Dir(folderPath & "\" & "*.xlsx")
Do While fileName <> ""
Set wb = Workbooks.Open(folderPath & "\" & fileName)
If fileCount = 0 Then
wb.Sheets("Sheet1").Range("a1").CurrentRegion.Copy wsOut.Range("A1")
fileCount = 1
Else
wb.Sheets("Sheet1").Range("a1").CurrentRegion.Offset(1, 0).Resize _
(wb.Sheets("Sheet1").Range("a1").CurrentRegion.Rows.Count - 1) _
.Copy wsOut.Range("A" & lrow)
End If
wb.Close savechanges:=False
Set wb = Nothing
lrow = wsOut.Range("a1").CurrentRegion.Rows.Count + 1
fileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub