Hi Watersev,

This still isn't working... stripping out the confidential data might not be an option it's a pretty big workbook. The only differences between this and dummy is that the data in range a11:B28 (dummy) is in B5:C1071, the validation list is in A5:A129 and the sheets are called "Summary2" and "trust Summary".

I've tried to adapt the code as follows: Can you see anywhere obvious where I've gone wrong?

Sub test()

Dim sh As Worksheet, rng As Range
Dim arr, result, arrlist As Object, vl, imin, imax
Dim j As Long, i As Long, itotal As Long, icounter As Long

Set sh = Sheets("Summary2")

sh.AutoFilterMode = 0

On Error Resume Next
Set rng = sh.Range(Replace(sh.Range("e2").Validation.Formula1, "=", ""))
If rng Is Nothing Then Exit Sub
On Error GoTo 0

arr = sh.Range("b6:c" & sh.Cells(Rows.Count, 1).End(xlUp).Row)

ReDim result(1 To UBound(arr), 1 To 6)

Set arrlist = CreateObject("System.Collections.arraylist")

For Each vl In rng
    
    j = j + 1
    result(j, 1) = vl
    
    For i = 1 To UBound(arr)
        
        If arr(i, 1) = vl Then
            
            arrlist.Add arr(i, 2)
            
            itotal = itotal + arr(i, 2)
            
            If imin = "" Then
                imin = arr(i, 2)
            Else
                If imin > arr(i, 2) Then imin = arr(i, 2)
            End If
            
            If imax = "" Then
                imax = arr(i, 2)
            Else
                If imax < arr(i, 2) Then imax = arr(i, 2)
            End If
            
            icounter = icounter + 1
        
        End If
        
    Next
    
    result(j, 2) = icounter
    
    If icounter > 0 Then
    
        arrlist.Sort
        
        If icounter Mod 2 = 0 Then
            result(j, 3) = (arrlist(icounter \ 2 - 1) + arrlist(icounter \ 2)) / 2
        Else
            result(j, 3) = arrlist(icounter \ 2)
        End If
        
        result(j, 4) = itotal / icounter
        result(j, 5) = imin
        result(j, 6) = imax
        
        itotal = 0: icounter = 0: imin = "": imax = "": arrlist.Clear
        
    End If
    
Next

Sheets("Trust Summary").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(j, 6) = result

End Sub