Excel - BUSCAR EN EXCEL CON MACRO

TENGO UNA BASE DE DATOS CON MAS DE 5000 PARTIDAS DE MATERIAL QUE SE INSTALA EN CONSTRUCCION, RESULTA QUE EN OCASIONES ALGUIEN SE EQUIVOCA Y ESCRIBE EL MATERIAL O ABREVIADO O EN DIFERENTE ORDEN, EJEMPLO:

1.- ANGULO MULTIPERFORADO DE 1/2" x 1/2" x 1/8" ESP. AC. INOX. 316
2.- ANGULO MULTIPERFORADO LI-1½-1/8
3.- ANG. MULTIPERF. DE 1/2X1/2X1/8 A.I 316

Y OBVIAMENTE NOS REFERIMOS AL MISMO MATERIAL, YO QUISIERA HACER UNA MACRO QUE ME ABRA UNA VENTANA SIMILAR A LA QUE APARECE ENLA AYUDA DE WINDOWS, EN LA QUE TECLEO UNA LETRA Y ME APARECEN TODAS LAS COINCIDENCIAS QUE EMPIEZEN CON ESA LETRA

IGUALMENTE YO DESEO CREAR UNA MACRO QUE ME AYUDE A REVISAR MI MATERIAL, TECLEO LA LETRA A Y ME APARECE TODO AQUEL MATERIAL QUE EMPIEZA CON A TECLEO AN Y ME APARECE EL MATERAIAL QUE EMPIEZA CON AN, ETC...ASI SEGUN LE ESCRIBA MAS LETRAS, ESTO CON LA INTENCION DE REVISAR MI RELACION Y RECODIFICAR EL MATERIAL REPETIDO

SI ALGUIEN ME PUEDE AYUDAR SE LO AGRADECERE

DESDE YA DE POR SI MUCHAS GRACIAS POR LA ATENCION

ATTE. JONATHAN GUTIERREZ

Acá te dejo un código que acabo de armar..
Seguro te va a servir...
(doy por hecho que sabés lo que tenés que hacer con el código!)

Private Sub TextBox1_Change()
Dim A() As String, n&
n = BuscarProximo([A1:A5000], TextBox1.Text, A)
ListBox1.Clear
If n > 0 Then ListBox1.List = A
Erase A
End Sub

'----------------------
'Módulo - By JuanC 24 de Octubre de 2006 - Para el Foro ;-)

Option Explicit

Public Function BuscarProximo(ByVal rngBusqueda As Range, ByVal sValor As String, ByRef arDestino() As String) As Long
Dim cell As Range, A As Range, B As Range
Dim sBuscado$, n&, sVal$
On Error Resume Next

If Trim(sValor) = "" Then Exit Function

Set A = rngBusqueda.SpecialCells(xlCellTypeConstants)
Set B = rngBusqueda.SpecialCells(xlCellTypeFormulas)

If Not A Is Nothing Then
If Not B Is Nothing Then
Set B = Union(A, B)
Else: Set B = A
End If
ElseIf B Is Nothing Then
Set B = rngBusqueda
End If

sBuscado = LCase(sValor) & "*"

For Each cell In B
With cell
If InStr(1, sVal, "Þ" & .Value & "Þ", vbTextCompare) = 0 Then
If LCase(.Value) Like sBuscado Then
ReDim Preserve arDestino(n + 1)
arDestino(n) = .Value
n = n + 1
sVal = sVal & "Þ" & .Value & "Þ"
End If
End If
End With
Next cell

If n > 0 Then Quick_Sort arDestino(), 0, UBound(arDestino()) - 1

BuscarProximo = n

Set A = Nothing
Set B = Nothing
Set cell = Nothing
End Function

'Este fragmento no me pertenece (ya ni recuerdo de dónde lo saqué)
Private Sub Quick_Sort(ByRef SortArray As Variant, ByVal First As Long, ByVal Last As Long)
Dim Low&, High&
Dim Temp As Variant, List_Separator As Variant
Low = First
High = Last
List_Separator = SortArray((First + Last) / 2)

Do
Do While (SortArray(Low) < List_Separator)
Low = Low + 1
Loop
Do While (SortArray(High) > List_Separator)
High = High - 1
Loop
If (Low <= High) Then
Temp = SortArray(Low)
SortArray(Low) = SortArray(High)
SortArray(High) = Temp
Low = Low + 1
High = High - 1
End If
Loop While (Low <= High)
If (First < High) Then Quick_Sort SortArray, First, High
If (Low < Last) Then Quick_Sort SortArray, Low, Last
End Sub

Saludos desde Baires, JuanC