VBA looping problem - Array only fills on first iteration of loop-CodePudding

Can someone please help me with the code below? I am quite new to VBA and can't quite figure out what is going wrong.

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 seems to work correctly 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.

Any help would be greatly appreciated.

'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")
Set resultTable = fr.ListObjects("Formatted_Results") 'Formatted_Results is named table in sheet fr
samplelist = WorksheetFunction.Unique(Range("ORIGINAL_SAMPLE")) ' This selects unique values from the Original Sample column (it is set as a named range in sheet fr)

'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

CodePudding user response：

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