Home > database >  How to get dynamically the Range of two non-contiguous filtered criteria with exception of first row
How to get dynamically the Range of two non-contiguous filtered criteria with exception of first row

Time:10-24

enter image description here

As you see on the sample picture, I set autofilter on column B and excluded the value B.
I need to get the visible range except the first row, with using UsedRange and SpecialCells(xlCellTypeVisible) method.
I tried the below three codes, but it either add additional row or throw an error:

Sub Get_Range_of_two_non_contiguous_filtered_criteria_except_First_Row()
 
    Dim ws As Worksheet, rng As Range
    Set ws = ThisWorkbook.ActiveSheet
 
    Set rng = ws.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible)
    Debug.Print rng.Address                                                  'Addtional Row is added to rng ($A$2:$B$3,$A$6:$B$8)
 
    Set rng = Intersect(ws.Cells, ws.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible))
    Debug.Print rng.Address                                                  'Addtional Row is added to rng $A$2:$B$3,$A$6:$B$8
 
    Dim crg As Range: Set crg = ws.UsedRange.SpecialCells(xlCellTypeVisible)
    Set crg = crg.Offset(1, 0).Resize(crg.Rows.Count - 1, crg.Columns.Count)    'Error: Application-defined or object-defined error
    Debug.Print crg.Address
 
End Sub

This is the only method I found that it works correctly:

Dim LastRow As Long
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = ws.Range("A2:B" & LastRow).SpecialCells(xlCellTypeVisible)
Debug.Print rng.Address

In Advance, thanks for all your help and comments.

CodePudding user response:

The next part is wrong:

    Dim crg As Range: Set crg = ws.UsedRange.SpecialCells(xlCellTypeVisible)
    Set crg = crg.Offset(1, 0).Resize(crg.Rows.Count - 1, crg.Columns.Count)    'Error: Application-defined or object-defined error
    Debug.Print crg.Address

You need to resize the used range BEFORE using SpecialCells. A discontinuous range cannot be resized in that way.

The next adapted code should work:

    Dim crg As Range: Set crg = ws.UsedRange
    Dim crgVS As Range
     Debug.Print crg.Resize(crg.rows.count - 1, crg.Columns.count).Offset(1).address
    Set crgVS = crg.Resize(crg.rows.count - 1, crg.Columns.count).Offset(1).SpecialCells(xlCellTypeVisible)
     Debug.Print crgVS.address

And I would (only) suggest you to use Range("A1").CurrentRegion. UsedRange works well on a virgin/new sheet. It may include the rows/columns you previously used to use them, even if they are empty now. Try coloring the interior or a cell below the existing range and check the UsedRange address. And results in such a case may not fulfill your expectations...

CodePudding user response:

iterating over the areas works:

    Dim crg as range, a As Range
    With ws.UsedRange.SpecialCells(xlCellTypeVisible)
        For Each a In .Areas
            If Not crg Is Nothing Then
                Set crg = Union(crg, a)
            Else
                'this area must include the first row -> remove
                Set crg = a.Offset(1).Resize(a.Rows.Count - 1)
            End If
        Next
    End With
  • Related