Bom dia!

Mais uma vez, pedimos, encarecidamente, que ao postar código VBA que o faça com o usu da ferramenta CODE existente logo no início da caixa de mensagens (quinto botão da esquerda para a direita). São as regras do fórum.

Essa dúvida não foi resolvida no tópico abaixo?
viewtopic.php?f=10&t=28635

Ok, não sabia dessa informação na próxima usarei o CODE.

Usei a explicação do outro post para resolver esse problema porém sem sucesso.
Se puder por favor ajudar resolver esse código fico agradecido,
obrigado pela atenção....

Assim

Esse jeito que você fez eu havia feito também, só que nesse código que postei acima não da certo.
Pelo que acho que entendi essa linha do CODE que postei acima, Conta os registros encontrados.
O que preciso é que Some a coluna H, porém adaptar nesse código achei muito difícil e até agora não consegui.
Poderia adaptar por gentileza. "o código é pequeno para analise da uma olhada por favor"...

    If lstLista.ListCount <= 0 Then
        lblMensagens.Caption = lstLista.ListCount & " registros encontrados"
    Else
        lblMensagens.Caption = lstLista.ListCount - 1 & " registros encontrados"

Isso

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
    
    Dim SomaRegistros As Long
    Dim SomaSolicitada As Long
    Dim UltimaLinha As Long
    Dim k As Long
    
    'Somar os registros
    UltimaLinha = Sheets("REGISTRO").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    If UltimaLinha < 2 Then UltimaLinha = 2
    
    For k = 2 To UltimaLinha
        SomaRegistros = SomaRegistros + CLng(Range("A" & k).Value)
        SomaSolicitada = SomaSolicitada + CLng(Range("H" & k).Value)
    Next
    
    
    

    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)
    Call MontaClausulaWhere(Me.Txt_PESQNOME.Name, "Nome", sqlWhere)
    Call MontaClausulaWhere(Me.txtNomeCOMPANY.Name, "Empresa", sqlWhere)
      Call MontaClausulaWhere(Me.Text_pesqdata.Name, "Data", sqlWhere)
     Call MontaClausulaWhere(Me.Text_pesqmatricula.Name, "Registro", sqlWhere)
     Call MontaClausulaWhere(Me.TextBoxCARGO.Name, "Cargo", 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
    
    
        'Atualiza o label da soma de registros
    If SomaRegistros <> 0 Then
        LabelSomaRegistros.Caption = "Soma dos Registros: " & SomaRegistros
    End If
        
    If SomaSolicitada <> 0 Then
        LabelSomaSolicitada.Caption = "Soma Solicitada: " & SomaSolicitada
    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

Edupm,

Ok, Tranquilo.

Desculpe. A finalidade aqui é tão somente manter o fórum organizado e de acordo com as regras existentes.

Desse modo, pedimos, além de usar a ferramenta CODE para os códigos VBA, não utilizar citações nas suas respostas. Citações são desnecessárias e devem restringir-se apenas a pequenas partes das respostas.

Boa tarde novamente!
Doutor deu certíssimo o solução para o problema em questão da soma... muito obrigado!
Só tenho uma dúvida nesse mesmo código abaixo...

Basicamente tenho o Textbox " txtNomeEmpresa " que insiro qualquer caractere e consequentemente no Listview filtra a informação desejada, gerando assim no Label " lblMensagens.Caption " o número de registro encontrados.

Vc me ajudou a contar e somar os registros encontrados, exemplo

teste 1
teste 2
teste 3

Label " lblMensagens.Caption = 03
Label " LabelSomaRegistros = 06

O problema está que quando faço a pesquisa no Textbox" txtNomeEmpresa " somente o Label " lblMensagens.Caption atualiza; Já o Label " LabelSomaRegistros não atualiza.
Pelo que percebi ele fica está buscando a informação da planilha na coluna H e não do Listview.

Poderia me ajudar a fazer a atualização do Label " LabelSomaRegistros do mesmo jeito do Label " lblMensagens.Caption ?

 
    '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
    
    
    
    Dim SomaRegistros As Long
    Dim UltimaLinha As Long
    Dim k As Long
    
    'Somar os registros
   ' UltimaLinha = Sheets("registro").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    UltimaLinha = Sheets("registro").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    If UltimaLinha < 2 Then UltimaLinha = 2
    
    For k = 2 To UltimaLinha
        SomaRegistros = SomaRegistros + CLng(Range("h" & k).Value)
    Next

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

     
    
    
       'Atualiza o label da soma de registros
    If SomaRegistros <> 0 Then
        LabelSomaRegistros.Caption = "Soma dos Registros: " & SomaRegistros
    End If
    ' Fecha o conjunto de registros.
    Set rst1 = Nothing
    ' Fecha a conexão.
    conn1.Close

    ' 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

Edupm,

Boa tarde!

Para alterar para a coluna H, basta alterar o número 1 da linha de comando:

UltimaLinha = Sheets("registro").Cells(Cells.Rows.Count, 1).End(xlUp).Row

Para 8 conforme linha de comando abaixo:

UltimaLinha = Sheets("registro").Cells(Cells.Rows.Count, 8).End(xlUp).Row

Wagner agradeço pela resposta não fui claro na explicação.... Por exemplo:

No Textbox eu digito: a palavra carro. Então no Listview vai aparecer tudo referente a Carro que existe no cadastro, conforme abaixo.

teste 1
carro 2
pedra 3
carro 4

Então no label abaixo o Resultado será 02 palavras referente a carro encontrados e na soma 06.

Label " lblMensagens.Caption = 02 registros encontrados
Label " LabelSomaRegistros = 06

Se apagar a palavra carro do textbox então o resultado será:

Label " lblMensagens.Caption = 04 registros encontrados
Label " LabelSomaRegistros = 10

O Label lblMensagens está funcionando perfeitamente, só o Label " LabelSomaRegistros que não...
ele só mostra a soma total de todos os registros, mas o que preciso é ao digitar uma palavra ele dar a SOMA dos valores corresponde a palavra digitada no Textbox....

Segue o código

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)
    Call MontaClausulaWhere(Me.Txt_PESQNOME.Name, "Nome", sqlWhere)
    Call MontaClausulaWhere(Me.txtNomeCOMPANY.Name, "Empresa", sqlWhere)
      Call MontaClausulaWhere(Me.Text_pesqdata.Name, "Data", sqlWhere)
     Call MontaClausulaWhere(Me.Text_pesqmatricula.Name, "Registro", sqlWhere)
     Call MontaClausulaWhere(Me.TextBoxCARGO.Name, "Cargo", 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
    
    
    
    Dim SomaRegistros As Long
    Dim UltimaLinha As Long
    Dim k As Long
    
    'Somar os registros
    UltimaLinha = Sheets("registro").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    If UltimaLinha < 2 Then UltimaLinha = 2
    
    For k = 2 To UltimaLinha
        SomaRegistros = SomaRegistros + CLng(Range("h" & k).Value)
    Next

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

     
    
    
       'Atualiza o label da soma de registros
    If SomaRegistros <> 0 Then
        LabelSomaRegistros.Caption = "Soma dos Registros: " & SomaRegistros
    End If
    ' Fecha o conjunto de registros.
    Set rst1 = Nothing
    ' Fecha a conexão.
    conn1.Close

    ' 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)

    Call MontaClausulaWhere(Me.Txt_PESQNOME.Name, "NomeDaEmpresa", sqlWhere)
    
    Call MontaClausulaWhere(Me.txtNomeCOMPANY.Name, "NomeDaEmpresa", sqlWhere)
    
    Call MontaClausulaWhere(Me.Text_pesqdata.Name, "NomeDaEmpresa", sqlWhere)
    
    Call MontaClausulaWhere(Me.Text_pesqmatricula.Name, "NomeDaEmpresa", sqlWhere)
    
    Call MontaClausulaWhere(Me.TextBoxCARGO.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

Bom dia!
Se puderem me ajudar fico grato... só falta essa resolução para concluir o código...

Bom dia Pessoal!

Foi resolvido agradeço a todos do Forum que me ajudaram a resolver... Como dizem vivendo e aprendendo...

Segue linha de resolução

'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

Dim j As Long

Dim soma As Long

soma = 0

For j = 1 To Me.lstLista.ListCount - 1
soma = soma + CLng(Me.lstLista.List(j, 7))
Next j

    Label131.Caption = soma

Até a próxima