BrUnOaFs,

Boa tarde!

Veja se é assim.

wagner,

Obrigado,

Se não for pedir demais,

Seria possível aparecer outras informações ao lado de cada nome?

ABRIL | Bruno Ferreira | R$ 405.000 | Vendido

OK.

Feito.

Wagner,

A única coisa que vi de problema é que:

"Carlos" é diferente de "carlos"

O valor minúsculo e maiúsculo eu não queria que fosse levado em consideração.

EDIT: Resolvi com o UCASE()

Porém, os nomes com acentos que estão pegando agora.

Tem alguma solução ?

https://www.youtube.com/watch?v=kwuLE0rFkCk
https://www.youtube.com/watch?v=VesNeMjWhhg
https://www.youtube.com/watch?v=brtdfos3Wk0
https://www.youtube.com/watch?v=tV1yMSdUTGY
https://www.youtube.com/watch?v=XB4P1k43thU
https://www.youtube.com/watch?v=Zy2fn0QZW0U

if removeacentos(ucase(nome1)) like removeacentos(ucase(nome2)) then


end if

Function RemoveAcentos(sString As String) As String
     
    Dim sAcentos As String
    Dim sSemAcentos As String
    Dim sTemp As String
    Dim i As Long
  
    'Liste nesta variável todos os acentos possíveis
    sAcentos = "àáâãäèéêëìíîïòóôõöùúûüÀÁÂÃÄÈÉÊËÌÍÎÒÓÔÕÖÙÚÛÜçÇñÑ"
      
    'Letras sem acentuação correspondentes para substituição
    sSemAcentos = "aaaaaeeeeiiiiooooouuuuAAAAAEEEEIIIOOOOOUUUUcCnN"
      
    'Armazena em sTemp a string recebida
    sTemp = sString
      
    'Loop que percorrerá todas as letras da variável 'sAcentos',
    'subtituindo pelo caractere correspondente em 'sSemAcentos'
    For i = 1 To Len(sAcentos)
        sTemp = Replace(sTemp, Mid(sAcentos, i, 1), Mid(sSemAcentos, i, 1))
    Next i
      
    'Retorna a nova string
    RemoveAcentos = sTemp
      
End Function

Function Acento(caract)
 
    'Acentos e caracteres especiais que serão buscados na string
    'Você pode definir outros caracteres nessa variável, mas
    ' precisará também colocar a letra correspondente em codiB
    codiA = "àáâãäèéêëìíîïòóôõöùúûüÀÁÂÃÄÈÉÊËÌÍÎÒÓÔÕÖÙÚÛÜçÇñÑ"
     
    'Letras correspondentes para substituição
    codiB = "aaaaaeeeeiiiiooooouuuuAAAAAEEEEIIIOOOOOUUUUcCnN"
     
    'Armazena em temp a string recebida
    temp = caract
     
    'Loop que irá de andará a string letra a letra
    For i = 1 To Len(temp)
     
        'InStr buscará se a letra indice i de temp pertence a
        ' codiA e se existir retornará a posição dela
        p = InStr(codiA, Mid(temp, i, 1))
         
        'Substitui a letra de indice i em codiA pela sua
        ' correspondente em codiB
        If p > 0 Then Mid(temp, i, 1) = Mid(codiB, p, 1)
    Next
     
    'Retorna a nova string
    Acento = temp
     
End Function

klarc28 e wagner,

Finalizei o código com a ajuda de vocês.

Só falta agora classificar por ordem de data a primeira coluna do listbox.

Private Sub Image3_Click()

    Dim i As Long
    Dim leg As Integer
    Dim UltimaLinha As Long
    Dim TextoProcurado As String
    
Application.ScreenUpdating = False
    
    UltimaLinha = Plan3.Cells(Cells.Rows.Count, 1).End(xlUp).Row
    If UltimaLinha < 2 Then UltimaLinha = 2
    
    TextoProcurado = "*" & UCase(txtCliente.Text) & "*"
    
    ListBox1.Clear
    
    leg = 0
    
    For i = 2 To UltimaLinha
        
        If RemoveAcentos(UCase(Plan3.Cells(i, 6).Value)) Like RemoveAcentos(UCase(TextoProcurado)) Then
        
            With Me.ListBox1
                 Me.ListBox1.ColumnCount = 7
                 Me.ListBox1.ColumnWidths = "56;178;160;58;58;100"
                .AddItem
                .List(leg, 0) = Plan3.Cells(i, 8)
                .List(leg, 1) = Plan3.Cells(i, 6)
                .List(leg, 2) = Plan3.Cells(i, 3)
                .List(leg, 3) = Plan3.Cells(i, 4) & "." & Plan3.Cells(i, 5)
                .List(leg, 4) = Format(Plan3.Cells(i, 7), "#,###0")
                .List(leg, 5) = Plan3.Cells(i, 11)
                .List(leg, 6) = Plan3.Cells(i, 10)
            End With
            
            leg = leg + 1
            
        End If
    Next
    
Application.ScreenUpdating = True

End Sub

Resolvido:

Private Sub Ordenar()

Dim i, j As Long
Dim x As Long
Dim Data1 As Date
Dim Data2 As Date

Dim Temp As String ' Aramzena provisoriamente a linha de registro

With Me.ListBox1

For j = ListBox1.ListCount - 1 To 0 Step -1 'Contagem da listbox

For i = LBound(.List) To UBound(.List) - 1 Step 1 ' Define os limites das linhas

Data1 = .List(i, 0) ' Pega a primeira data a ser comparada
Data2 = .List(i + 1, 0) ' Pega a segunda data a ser comaparada, ou seja a linha posição I mais uma

If Data1 < Data2 Then ' Verifica se a primeira data é maior que a segunda

For x = 0 To (.ColumnCount - 1) Step 1 ' Percorre as colunas para mover os dados de todas elas

Temp = .List(i, x) ' Armazena na variável Temporaria o registro referente a linha I, coluna por coluna
.List(i, x) = .List(i + 1, x) ' Trasnfere registro para linha anterior
.List(i + 1, x) = Temp ' Insere novamente os valores da variável temporaria na próxima linha
 
Next

End If

Next i
Next j

End With
   
End Sub