Array only fills on first iteration of loop

Question

I have a results table with multiple results for multiple samples, and a sample list array containing each unique sample reference value in the results table.

I am trying to loop through the sample list to:

• Filter the results table for each sample.
• Fill an array with the filtered values
• Create a new sheet for each sample
• Output the array to the new sheet

The code works for the first iteration of the loop however, on each subsequent run through, the array only contains a single row, and only the table header values are output to the created sheets.

'define excel variables
Dim resultTable As ListObject
Dim resultsArr() As Variant
Dim fr As Worksheet
Dim samplelist() As Variant
Dim sheetname As String

'Set excel variables
Set fr = ThisWorkbook.Sheets("Formatted Results")

'Formatted_Results is named table in sheet fr
Set resultTable = fr.ListObjects("Formatted_Results")

'This selects unique values from the Original Sample column
' (it is set as a named range in sheet fr)
samplelist = WorksheetFunction.Unique(Range("ORIGINAL_SAMPLE")) 

'Start loop for each unique sample number -
For Each sampleNo In samplelist
    resultTable.DataBodyRange.AutoFilter Field:=1, Criteria1:=sampleNo 
    'autofilter on sampleNo
    resultsArr = resultTable.Range.SpecialCells(xlCellTypeVisible)
    sheetname = "Sample " & sampleNo
    Sheets.Add.Name = sheetname
    With ThisWorkbook.Sheets(sheetname)
        .Range("A6").Resize(UBound(resultsArr, 1), UBound(resultsArr, 2)).Value = resultsArr
    End With
Next sampleNo

Answer 1

When you access a filtered list via SpecialCells(xlCellTypeVisible), the result is a non-contiguous range. Copying data from such a range copies only the values from the first Subrange.

I am not aware that there is a build-in way to copy the data of all subranges at once. You will need to loop over the subranges manually. You can access the subranges with the Areas-property of a range. Areas works for every range, so if the range is contiguous, Areas(1) accesses the whole range.

Dim r as Range, a as Range, row as Long
Set r = resultTable.Range.SpecialCells(xlCellTypeVisible)
row = 1
With ThisWorkbook.Sheets(sheetname)
For Each a In r.Areas
    .Cells(row, 6).Resize(a.Rows.Count, a.Columns.Count) = a.Value2
    row = row + a.Rows.Count
Next
Exit Sub