Este es el resultado de la macro, la macro buscara lo que pongas en el combobox incluyendo una sola letra y te mostrara solo los resultados positivos en el listbox, los cuales cargara con todo y títulos
y esta es la macro
Private Sub ComboBox1_Change()
Set TABLA = Range("TABLA")
DIAGNOSTICO = ComboBox1.Value
Range("G4").CurrentRegion.Clear
With TABLA
FILAS = .Rows.Count
COL = .Columns.Count
End With
With ActiveSheet
If .AutoFilterMode = True Then .AutoFilterMode = False
End With
With ActiveSheet.Range("a4")
.AutoFilter Field:=3, Criteria1:="=*" & DIAGNOSTICO & "*", Operator:=xlAnd
.Range(TABLA.Address).AutoFilter Field:=4, Criteria1:="POSITIVO"
Range("A4").CurrentRegion.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Range("G4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
ActiveSheet.AutoFilterMode = False
Set DATOS = Range("G4").CurrentRegion
With DATOS
FILAS = .Rows.Count
COL = .Columns.Count
Set DATOS = .Rows(2).Resize(FILAS, COL)
With ListBox1
.RowSource = DATOS.Address
.ColumnCount = DATOS.Columns.Count
.ColumnHeads = True
End With
End With
SAL:
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
Dim UNICOS As New Collection
Set DATOS = Range("A4").CurrentRegion
With DATOS
FILAS = .Rows.Count
Set DATOS = .Rows(2).Resize(FILAS - 1)
With ListBox1
.RowSource = DATOS.Address
.ColumnCount = DATOS.Columns.Count
.ColumnHeads = True
End With
For I = 1 To FILAS - 1
DIAGNOSTICO = .Cells(I, 3)
On Error Resume Next
UNICOS.Add DIAGNOSTICO, CStr(DIAGNOSTICO)
If Err.Number = 0 Then ComboBox1.AddItem DIAGNOSTICO
On Error GoTo 0
Next I
.Name = "TABLA"
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Range("G4").CurrentRegion.Clear
End Sub