Selecting Nth Row of Filtered Data - excel

Question

I want to tag specified lines of a table for sample review.
Due to the volume of data, running repeated loops over the entire population would result in unacceptably long runtimes (as I have to tag specified sub-populations for QA sampling).
The approach I have taken is to bring in the table, and then filter based on the population I want to sample (for example, filter by location, by product, and by analyst) and then select a percentage of that population for sampling by putting "Sample" into a column.
I have tried several permutations of the code.
The first, where I used the Areas function, threw 1004 errors if there was more than one row.
The second gives strange row selections, including selecting non-hidden rows (and I can't understand why it is picking the rows that it is, as they don't seem to be correctly offset even if it was going by "all rows" not just visible rows).
ActiveSheet.ListObjects("SourceDataTable").Range.AutoFilter Field:=1, Criteria1:="Product1"
sectionCount = ActiveSheet.ListObjects("SourceDataTable").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
If sectionCount = 0 Then sectionSampleSize = 0 Else sectionSampleSize = Int((sectionCount / 10) + 0.5)
MsgBox ("Analyst " & analystLoopCellRef.Value & " ecomm section count is " & sectionCount & " and sample size is " & sectionSampleSize)
Do While sectionSampleSize > 0
sectionLoopRand = Int(sectionCount * Rnd + 1)
MsgBox (sectionLoopRand)
' MsgBox (ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Areas(1).Columns(40).Rows(sectionLoopRand).Cells(1, 1).Value)
If ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Columns(40).Rows(sectionLoopRand).Cells(1, 1).Value = "Sample" Then
MsgBox ("Sample overlap")
Else
ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Columns(40).Rows(sectionLoopRand).Cells(1, 1).Value = "Sample"
' MsgBox ("Sample address is " & ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Columns(40).Rows(sectionLoopRand).Cells(1, 1).Address)
sectionSampleSize = sectionSampleSize - 1
' MsgBox ("Sample selected")
End If
Loop
Older version
ActiveSheet.ListObjects("SourceDataTable").Range.AutoFilter Field:=1, Criteria1:="Product1"
sectionCount = ActiveSheet.ListObjects("SourceDataTable").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
If sectionCount = 0 Then sectionSampleSize = 0 Else sectionSampleSize = Int((sectionCount / 10) + 0.5)
MsgBox ("Analyst " & analystLoopCellRef.Value & " ecomm section count is " & sectionCount & " and sample size is " & sectionSampleSize)
Do While sectionSampleSize > 0
sectionLoopRand = Int(sectionCount * Rnd + 1)
MsgBox (sectionLoopRand)
' MsgBox (ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Areas(sectionLoopRand).Columns(40).Cells(1, 1).Value)
If ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Areas(sectionLoopRand).Columns(40).Cells(1, 1).Value = "Sample" Then
MsgBox ("Sample overlap")
Else
ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Areas(sectionLoopRand).Columns(40).Cells(1, 1).Value = "Sample"
'' MsgBox ("Sample address is " & ActiveSheet.ListObjects("SourceDataTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Areas(sectionLoopRand).Columns(40).Cells(1, 1).Address)
sectionSampleSize = sectionSampleSize - 1
' MsgBox ("Sample selected")
End If
Loop

Answer 1

Auto filters can create non-contiguous ranges with multiple areas which can be problematic for normal range methods. One way is to loop through the visible cells and build an array of the addresses (or rows). Then by selecting an array element at random you can get the address of a cell in the visible range. For example
Option Explicit
Sub mysample()
Const TABLE_NAME = "SourceDataTable"
Const FILTER_COL = 1
Const TABLE_COL = 40 ' word sample added in table col 40
Const SAMPLE_TERM = "Product1"
Const SAMPLE_RATE = 10 ' 1 in 10 sampled
Const LOOP_MAX = 10000 ' avoid infinite while loop
Dim wb As Workbook, ws As Worksheet
Dim tbl As ListObject, rng As Range, t0 As Single
t0 = Timer
Set wb = ThisWorkbook
Set ws = wb.ActiveSheet
' apply filter and set rng to visible cells in filter col
Set tbl = ws.ListObjects(TABLE_NAME)
tbl.Range.AutoFilter Field:=FILTER_COL, Criteria1:=SAMPLE_TERM
Set rng = tbl.Range.Columns(FILTER_COL).SpecialCells(xlCellTypeVisible)
Debug.Print rng.Address, rng.Cells.Count
' build myrows array of addresses from rng.cells
Dim iCount As Integer, myrows() As String, cell As Range
iCount = -1 ' myrows(0) will be header
ReDim myrows(rng.Cells.Count)
For Each cell In rng.Cells
iCount = iCount + 1
myrows(iCount) = cell.Address
'Debug.Print iCount, cell.Address, cell.Row
Next
' determine sample size
Dim iSampleSize As Integer
If iCount > SAMPLE_RATE / 2 Then
iSampleSize = Round(iCount / SAMPLE_RATE, 0)
End If
'Debug.Print iSampleSize
' select sample
Dim n As Integer, x As Integer, z As Integer
n = 0
Do While n < iSampleSize
' pick one at random
x = 1 + Int(Rnd * iCount) ' avoid header row 0
'Debug.Print n, x
' update table if not previously chosen
If Len(myrows(x)) > 0 Then
ws.Range(myrows(x)).Offset(0, TABLE_COL - FILTER_COL) = "Sample"
myrows(x) = "" ' avoid repeat
n = n + 1
End If
z = z + 1 ' avoid endless loop
If z > LOOP_MAX Then
MsgBox "Max iterations in While Loop exceeded", vbCritical
Exit Sub
End If
Loop
MsgBox iSampleSize & " items selected from " & iCount, vbInformation, "Completed in " & Int(Timer - t0) & " secs"
End Sub