Como arrojar estadística al momento de buscar por un criterio en un lisbox
Ojala me pueda ayudar tengo un formulario Evaluación donde me busca por dos criterios por Apellidos y Profesión, cuando le doy click a profesión y busco en la caja de texto en este caso lo hice por Psicología me filtra 5 registros, lo que deseo es que cuando busque por este criterio me arroje todos esos datos que estan dentro del FRAME (Estadística) como la que adjunto en la imagen, si se dan cuenta allí aparece Disponibles 3, debería funcionar que cuando busque me traiga el dato de la hoja Profesión al momento de la búsqueda por profesión del formulario y disponibles significa que solo se necesitan 3 cupos para esa profesión es como un aviso, después que me muestre la nota máxima y mínima de solo los que aprobaron para esa profesión buscada, el otro cálculo es la nota desaprobada máxima y por último que me arroje la cantidad de aprobados y desaprobados. Ojala me puedan ayudar lo he intentado hacer con COUNTIF, MAX, MIN, pero no logro dar, este es el formulario de como debería quedar.
Y esta es la hoja profesión que se puede incrementar a mas profesiones que allí solo me muestra la cantidad de cuantos solo pueden ingresar y eso quiero que se compare con la hoja Registros y cuando busque por profesión me arroje un aviso de cuantos cupos se requieren para esa profesión.
Y este ultimo es el código que estoy utilizando para búsqueda por los dos criterios Apellidos y Profesión.
Sub Listar() Dim arrayItems() Dim VResultado As Boolean Dim Linea, Columna, Cont, Nlineas, CantReg As Long Dim MyList Cont = 1 CantReg = 0 Nlineas = Sheets("Registro").Range("A20000").End(xlUp).Row If Nlineas = 1 Then Else ReDim arrayItems(1 To Nlineas, 1 To Sheets("Registro").UsedRange.Columns.Count) With Me.LstCarga .Clear .ColumnCount = 6 .ColumnWidths = "23;50;150;70;20;70" With Sheets("Registro") MyList = .Range("A1:A" & Nlineas) For Linea = 5 To UBound(MyList) VResultado = True If Optprofesion.Value = True Then VResultado = .Range("D" & Linea).Value Like "*" + TxtBuscar + "*" End If If OptApellidos.Value = True Then VResultado = .Range("C" & Linea).Value Like "*" + TxtBuscar + "*" End If If VResultado Then Me.LstCarga.AddItem For Columna = 1 To 6 arrayItems(Cont, Columna) = .Cells(Linea, Columna).Value Next Columna Cont = Cont + 1 End If Next Linea Me.LstCarga.List = arrayItems() End With End With LblRegistros = "Registros: " & CantReg For i = 0 To LstCarga.ListCount - 1 If LstCarga.List(i, 2) <> Empty Then CantReg = CCur(CantReg) + 1 End If LblRegistros = "Registros: " & CantReg Next i End If Exit Sub End Sub