I've been thinking about getting the data in the 4th filtered range and what works for me is to loop through all visible cells and exit for when the counter hits 4.

Sub VBAArray2()
    
    Dim randomRng As Range, counterGuess As Integer
    With Sheets(1)
    
        .Range("A1").AutoFilter 3, "A<B"
        For Each randomRng In .Range("A2:A11").SpecialCells(xlCellTypeVisible)
    
            If randomRng < randomRng.Offset(0, 1) Then
                counterGuess = counterGuess + 1
            End If
    
            If counterGuess = 4 Then
                Exit For
            End If
        Next
    
        MsgBox randomRng.Value
    
    End With
End Sub

May I know if there's more straightforward alternative ? specialcells(xlcelltypevisible).Areas(4) doesn't always work since the 4th filter range might be different areas each time.

I've been thinking about getting the data in the 4th filtered range and what works for me is to loop through all visible cells and exit for when the counter hits 4.

Sub VBAArray2()
    
    Dim randomRng As Range, counterGuess As Integer
    With Sheets(1)
    
        .Range("A1").AutoFilter 3, "A<B"
        For Each randomRng In .Range("A2:A11").SpecialCells(xlCellTypeVisible)
    
            If randomRng < randomRng.Offset(0, 1) Then
                counterGuess = counterGuess + 1
            End If
    
            If counterGuess = 4 Then
                Exit For
            End If
        Next
    
        MsgBox randomRng.Value
    
    End With
End Sub

May I know if there's more straightforward alternative ? specialcells(xlcelltypevisible).Areas(4) doesn't always work since the 4th filter range might be different areas each time.

• excel
• vba

• I ended up copying the filtered column, pasting it somewhere and treating it as an Area, which allows me to offset without much effort. – Kuan Chun Yeh Commented Mar 17 at 3:46

2 Answers 2

Alternative is to loop through areas

Option Explicit

Sub VBAArray2()

    Const NUM = 4
    
    Dim rng As Range, lastrow As Long
    Dim i As Long, m As Long, n As Long
    
    ' set filter
    With Sheets(1)
        lastrow = .Cells(.Rows.Count, "A").Rows(xlUp).Row
        .Range("A1").AutoFilter 3, "A<B"
        Set rng = .Range("A2:A" & lastrow).SpecialCells(xlCellTypeVisible)
    End With
    
    ' check enough rows
    If rng.Cells.Count < NUM Then
       MsgBox "Row count < " & NUM, vbCritical
       Exit Sub
    End If
    
    ' iterate areas
    Do
        m = n
        i = i + 1
        n = n + rng.Areas(i).Rows.Count
    Loop While n < NUM
    
    ' result
    MsgBox rng.Areas(i).Cells(NUM - m)
  
End Sub

Return N-th Match

• If you're going to filter by the 3rd, possibly unwanted column (=IF(A2<B2,"A<B","")), you don't need to additionally check if the values match your condition because you have already 'asked' Excel to do so:

  For Each randomRng In .Range("A2:A11").SpecialCells(xlCellTypeVisible).Cells
      counterGuess = counterGuess + 1
      If counterGuess = 4 Then Exit For
  Next randomRng 
  

• If not, loop through all the cells to perform the comparisons in VBA:

  For Each randomRng In .Range("A2:A11").Cells
       If randomRng.Value < randomRng.Offset(0, 1).Value Then
           counterGuess = counterGuess + 1
           If counterGuess = 4 Then Exit For
       End If
  Next randomRng 
  

• The following illustrates how to increase efficiency by using arrays in the latter case.

Sub VBAArray2()

    ' Define constants.    
    Const SHEET_ID As Variant = 1 ' risky; safer is e.g. "Sheet1"
    Const RETURN_FIRST_CELL_ADDRESS As String = "A2"
    Const COMPARE_COLUMN As String = "B"
    Const MATCH_INDEX As Long = 4
    
    ' Reference the objects.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(SHEET_ID)
    If ws.FilterMode Then ws.ShowAllData ' clear filters
    Dim fcell As Range: Set fcell = ws.Range(RETURN_FIRST_CELL_ADDRESS)
    
    ' Calculate the number of rows.
    Dim RowsCount As Long:  RowsCount = ws.Cells(ws.Rows.Count, fcell.Column) _
        .End(xlUp).Row - fcell.Row + 1
    If RowsCount < MATCH_INDEX Then
        MsgBox "Not enough rows of data found in ""'" & ws.Name & "'!" _
            & fcell.Resize(ws.Rows.Count - fcell.Row + 1).Address(0, 0) _
            & """!", vbExclamation
        Exit Sub
    End If
        
    ' Return the tow columns' values in arrays.
    Dim rrg As Range: Set rrg = fcell.Resize(RowsCount)
    Dim ReturnData() As Variant: ReturnData = rrg.Value
    Dim CompareData() As Variant:
    CompareData = rrg.EntireRow.Columns(COMPARE_COLUMN).Value
    
    ' Declare addtional variables.
    Dim ReturnValue As Variant, CompareValue As Variant
    Dim r As Long, MatchCount As Long
    
    ' Loop through the rows of the arrays and compare the values.
    ' Exit on the required (nth) match.
    For r = 1 To RowsCount
        ReturnValue = ReturnData(r, 1)
        If VarType(ReturnValue) = vbDouble Then ' is a number
            CompareValue = CompareData(r, 1)
            If VarType(CompareValue) = vbDouble Then ' is a number
                If ReturnValue < CompareValue Then
                    MatchCount = MatchCount + 1
                    If MatchCount = MATCH_INDEX Then Exit For
                End If
            End If
        End If
    Next r
    
    ' Inform.
    Select Case MatchCount
        Case 0: MsgBox "No matches found!", vbExclamation
        Case MATCH_INDEX: MsgBox "Result: " & ReturnValue, vbInformation
        Case Else:
            MsgBox "Only " & MatchCount & " match" _
                & IIf(MatchCount = 1, "", "es") & " found!", vbExclamation
    End Select

End Sub