Listview Não mostra texto no Campo Empresa só os números.

Como não consigo postar a planilha aqui peço que analisem o código abaixo e me ajudem por favor....

'Cole as informações na célula A1 do excel

Código Registro Nome Empresa
1 1322 a 1322
2 1459 b 1459
3 839 c 839
4 0 g TOYOTA
5 0 h AUDI

'Cole o código abaixo no vba excel

Private TextoDigitado As String
Private Const Ascendente As Byte = 0
Private Const Descendente As Byte = 1

Dim BANCO As Database
Dim TABELA As Recordset




Private Sub btnFiltrar_Click()
 
    Call PopulaListBox(txtNomeEmpresa.Text)
 
End Sub

Private Sub lstLista_Click()

End Sub

Private Sub txtNomeEmpresa_Change()

Me.txtNomeEmpresa = UCase(Me.txtNomeEmpresa.Text)

    TextoDigitado = txtNomeEmpresa.Text
   ' Call PreencheLista
Call PopulaListBox(vbNullString)
End Sub


Private Sub PopulaListBox(ByVal NomeEmpresa As String)


Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

    On Error GoTo TrataErro

    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim sql As String
    Dim sqlWhere As String
    Dim sqlOrderBy As String
    Dim i As Integer
    Dim campo As Field
    Dim myArray() As Variant

    Set conn = New ADODB.Connection
    With conn
        .Provider = "Microsoft.JET.OLEDB.4.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0;"
        .Open
    End With

    sql = "SELECT * FROM [REGISTRO$]"

    'monta a cláusula WHERE
    'NomeDaEmpresa
    Call MontaClausulaWhere(txtNomeEmpresa.Name, "Objetivos", sqlWhere)
    
         
    
    'faz a união da string SQL com a cláusula WHERE
    If sqlWhere <> vbNullString Then
        sql = sql & " WHERE " & sqlWhere
    End If

    'faz a união da string SQL com a cláusula ORDER BY
   

    Set rst = New ADODB.Recordset
    With rst
        .ActiveConnection = conn
        .Open sql, conn, adOpenDynamic, _
              adLockBatchOptimistic
    End With

    'pega o número de registros para atribuí-lo ao listbox
    lstLista.ColumnCount = rst.Fields.Count

    'preenche o combobox com os nomes dos campos
    'persiste o índice
    Dim indiceTemp As Long
    
    
    'recupera o índice selecionado
 

    'coloca as linhas do RecordSet num Array, se houver linhas neste
    If Not rst.EOF And Not rst.BOF Then
        myArray = rst.GetRows
        'troca linhas por colunas no Array
        myArray = Array2DTranspose(myArray)
        'atribui o Array ao listbox
        lstLista.List = myArray
        'adiciona a linha de cabeçalho da coluna
        lstLista.AddItem , 0
        'preenche o cabeçalho
        For i = 0 To rst.Fields.Count - 1
            lstLista.List(0, i) = rst.Fields(i).Name
        Next i
        'seleciona o primeiro item da lista
        lstLista.ListIndex = 0
    Else
        lstLista.Clear
    End If

    'atualiza o label de mensagens
    If lstLista.ListCount <= 0 Then
        lblMensagens.Caption = lstLista.ListCount & " registros encontrados"
    Else
        lblMensagens.Caption = lstLista.ListCount - 1 & " registros encontrados"
    End If

    ' Fecha o conjunto de registros.
    Set rst = Nothing
    ' Fecha a conexão.
    conn.Close

TrataSaida:
    Exit Sub
TrataErro:
    Debug.Print Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
    Resume TrataSaida
    
    
           Dim wis As Worksheet
   
    Dim TextoCelula As String
   
        
    
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Worksheets(1)
    i = 1
    lstLista.Clear
    With ws
        While .Cells(i, 1).Value <> Empty
            TextoCelula = .Cells(i, 1).Value
            If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
               lstLista.AddItem .Cells(i, 1)
            End If
            i = i + 1
        Wend
      
    
    Set conn = New ADODB.Connection
    With conn
        .Provider = "Microsoft.JET.OLEDB.4.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0;"
        .Open
    End With

    sql = "SELECT * FROM [Fornecedores$]"

    'monta a cláusula WHERE
    'NomeDaEmpresa
     Call MontaClausulaWhere(txtNomeEmpresa.Name, "NomeDaEmpresa", sqlWhere)

   

    'faz a união da string SQL com a cláusula WHERE
    If sqlWhere <> vbNullString Then
        sql = sql & " WHERE " & sqlWhere
    End If

    'faz a união da string SQL com a cláusula ORDER BY
   

    Set rst = New ADODB.Recordset
    With rst
        .ActiveConnection = conn
        .Open sql, conn, adOpenDynamic, _
              adLockBatchOptimistic
    End With

    'pega o número de registros para atribuí-lo ao listbox
    lstLista.ColumnCount = rst.Fields.Count

    'preenche o combobox com os nomes dos campos
    'persiste o índice
    
    
    For Each campo In rst.Fields
     
    Next
    'recupera o índice selecionado
 

    'coloca as linhas do RecordSet num Array, se houver linhas neste
    If Not rst.EOF And Not rst.BOF Then
        myArray = rst.GetRows
        'troca linhas por colunas no Array
        myArray = Array2DTranspose(myArray)
        'atribui o Array ao listbox
        lstLista.List = myArray
        'adiciona a linha de cabeçalho da coluna
        lstLista.AddItem , 0
        'preenche o cabeçalho
        For i = 0 To rst.Fields.Count - 1
            lstLista.List(0, i) = rst.Fields(i).Name
        Next i
        'seleciona o primeiro item da lista
        lstLista.ListIndex = 0
    Else
        lstLista.Clear
    End If

    'atualiza o label de mensagens
    If lstLista.ListCount <= 0 Then
        lblMensagens.Caption = lstLista.ListCount & " registros encontrados"
    Else
        lblMensagens.Caption = lstLista.ListCount - 1 & " registros encontrados"
    End If

    ' Fecha o conjunto de registros.
    Set rst = Nothing
    ' Fecha a conexão.
    conn.Close


    Exit Sub

    Debug.Print Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
    Resume TrataSaida
    End With

    
    Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
    
    
    
End Sub

Private Sub MontaClausulaWhere(ByVal NomeControle As String, ByVal NomeCampo As String, ByRef sqlWhere As String)
'NomeDoContato
    If Trim(Me.Controls(NomeControle).Text) <> vbNullString Then
        If sqlWhere <> vbNullString Then
            sqlWhere = sqlWhere & " AND"
        End If
        sqlWhere = sqlWhere & " " & NomeCampo & " LIKE '%" & Trim(Me.Controls(NomeControle).Text) & "%'"
    End If
    
    'NomeDoContato
    If Trim(Me.Controls(NomeControle).Text) <> vbNullString Then
        If sqlWhereb <> vbNullString Then
            sqlWhereb = sqlWhereb & " AND"
        End If
        sqlWhereb = sqlWhereb & " " & NomeCampos & " LIKE '%" & Trim(Me.Controls(NomeControle).Text) & "%'"
    End If
    
End Sub

'Faz a transpasição de um array, transformando linhas em colunas
Private Function Array2DTranspose(avValues As Variant) As Variant
    Dim lThisCol As Long, lThisRow As Long
    Dim lUb2 As Long, lLb2 As Long
    Dim lUb1 As Long, lLb1 As Long
    Dim avTransposed As Variant

    If IsArray(avValues) Then
        On Error GoTo ErrFailed
        lUb2 = UBound(avValues, 2)
        lLb2 = LBound(avValues, 2)
        lUb1 = UBound(avValues, 1)
        lLb1 = LBound(avValues, 1)

        ReDim avTransposed(lLb2 To lUb2, lLb1 To lUb1)
        For lThisCol = lLb1 To lUb1
            For lThisRow = lLb2 To lUb2
                avTransposed(lThisRow, lThisCol) = avValues(lThisCol, lThisRow)
            Next
        Next
    End If

    Array2DTranspose = avTransposed
    Exit Function

ErrFailed:
    Debug.Print Err.Description
    Debug.Assert False
    Array2DTranspose = Empty
    Exit Function
    Resume
    
   
    
End Function