I’m trying to figure out how to select multiple non contiguous ranges using
My worksheet (Sheet5) looks something like this:
| A | B | C | D | E | F | +---+---+---+--------+---+-----------+ 1|...|...|...|Category|...|Description| 2|...|...|...|Apple |...|Fruit | 3|...|...|...|Carrot |...|Vegetable | 4|...|...|...|Hat |...|Clothing |
- I want to set the
Categorycolumn and the
Descriptioncolumn to a range that I can copy and paste to another file.
- Column titles are in the first row.
- The columns I’m looking for are currently in
Column Fbut they are likely to move.
- The two columns are non-contiguous ranges, I don’t want to select anything in
Column Efor example.
The code I have so far finds the
Description column, and the
lastrow. As I am using variables to select the range, I am using
Sub SelectNonContiguousRangeCells() 'Create variables Dim wb As Workbook Dim ws As Worksheet Dim rng As Range Dim lastrow As Long Dim strCat As String Dim strDesc As String Dim rngCat As Range Dim rngDesc As Range Dim rngCopy As Range 'Initialize variables Set wb = ThisWorkbook Set ws = Sheet5 lastrow = ws.Range("A1").End(xlDown).Row 'Find the column headers strCat = "Category New" strDesc = "Requirement Description" Set rngCat = ws.Range("A1:Z1").Find(strCat) Set rngDesc = ws.Range("A1:Z1").Find(strDesc) 'Set the copy range Set rngCopy = Range(Range(Cells(1, rngCat.Column), Cells(lastrow, rngCat.Column)), Range(Cells(1, rngDesc.Column), Cells(lastrow, rngDesc.Column))).SpecialCells(xlCellTypeVisible) Debug.Print rngCopy.Address End Sub
The range that returns in my
Debug.Print here is
$D$1:$F$449, which is a contiguous range, while I’m hoping to see
$D$1:$D$449,$F$1:$F$449, which is a non-contiguous range.
I’ve looked at this answer and found some useful information, but it doesn’t seem to help with non-contiguous ranges.
I’ve also been looking through the Range.Cells documentation on MSDN with no luck.
How can I use my variables to select the columns containing
Description without anything in between?
You can use
Union to accomplish this.
You also need to code for the option of neither of your header values being found. Otherwise you may end up pushing a value of
Nothing into a range which will error out
Option Explicit Sub SelectNonContiguousRangeCells() Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet5") Dim rngCat As Range, rngDesc As Range, rngCopy As Range Dim lastrow As Long lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row Set rngCat = ws.Range("A1:Z1").Find("Category New").Resize(lastrow, 1) Set rngDesc = ws.Range("A1:Z1").Find("Requirement Description").Resize(lastrow, 1) If Not rngCat Is Nothing Then If Not rngDesc Is Nothing Then Set rngCopy = Union(rngCat, rngDesc) End If End If Debug.Print rngCopy.Address (False, False) End Sub