Sub test()
Dim a As Integer, b As Integer, c As Integer
Dim lngCounter As Long, lastrow As Long
Dim population As Integer, sample As Integer, maxdiff As Integer
Dim CalcSetting, x As Long
population = 25
sample = 3
maxdiff = 15
If (population ^ sample) > 65536 Then
MsgBox "Too many to handle"
Exit Sub
End If
CalcSetting = Application.Calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ActiveSheet
.Cells.ClearContents
For a = 1 To population
For b = 1 To population
For c = 1 To population
.Cells(lngCounter + 1, 1) = a
.Cells(lngCounter + 1, 2) = b
.Cells(lngCounter + 1, 3) = c
.Cells(lngCounter + 1, sample + 1).FormulaArray = _
"=SUM(IF(ABS(RC[-" & sample - 1 & "]:RC[-1]-RC[-" _
& sample & "]:RC[-2])<=" & maxdiff & ",1))+SUM(1/COUNTIF(RC[-" _
& sample & "]:RC[-1],RC[-" & sample & "]:RC[-1]))"
lngCounter = lngCounter + 1
Next c
Next b
Next a
If (population ^ sample) < 65536 Then
.Rows(1).Insert
.Cells(1, sample + 1) = "temp"
.Cells(1, sample + 1).AutoFilter Field:=sample + 1, Criteria1:="<>" & (2 * sample) - 1
.Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Columns(sample + 1).ClearContents
Else
For x = 65536 To 1 Step -1
If .Cells(x, sample + 1) <> sample - 1 Then Rows(x).Delete
Next x
End If
End With
Application.Calculation = CalcSetting
End Sub