sinceramente não entendi a demanda.
Voçe tem/conhece a rotina/maneira de obter a quantidade de registros em seu listbox. --> Contador - lstlista.listcount

Voçe tem/conhece a rotina/maneira de atribuir esse valor ao Label --> lblContador.Caption.....

Reinaldo,

É isso mesmo. Tenho um listbox e gostaria que aparecesse em uma label a quantidade de registros filtrados nesse listbox. Tenho o código acima citado, mas não estou sabendo usar ou onde usar.

É isso aí. Um abraço.

Paulo Cezar.

Apos a rotina/trecho que carrega sua listbox coloque a chamada a rotina que conta.
Algo +/- assim
....sualistview additem....
....
call Contaritens

Reinaldo,

O código que estou usando no LISTBOX é esse abaixo, pelo fato do pouco conhecimento que tenho em VBA peguei na NET (muito confuso pra mim). Me diga onde devo inserir o CALL ContarItens nesse código:

Private Const NomePlanilha As String = "BDDADOS"
Private Const LinhaCabecalho As Integer = 1

Private Sub Campos_Change()
    If Campos <> "" Then
        Application.ScreenUpdating = False
        Dim vBusca
        Set vBusca = Nothing
        With ThisWorkbook.Sheets(NomePlanilha)
            .Activate
            With .Range("A:G")
                Set vBusca = .Find(Campos, LookIn:=xlValues, LookAt:=xlPart)
                    If Not vBusca Is Nothing Then
                        .Range(vBusca.Address).Select
                    End If
            End With
        End With
    ThisWorkbook.Sheets("BDDADOS").Activate
    Application.ScreenUpdating = True
    End If

End Sub

Private Sub CommandButton6_Click()
Unload Me
End Sub

Private Sub Filtro_Change()
    If Me.Campos.ListIndex <> -1 Then
        Call PreencheLista(Filtro.Text)
    End If
End Sub
Private Sub UserForm_Initialize()
    Call PreencheCampos
End Sub

Private Sub PreencheCampos()
    Dim ws As Worksheet
    Dim coluna As Integer
    Dim linha As Integer
    Set ws = ThisWorkbook.Worksheets(NomePlanilha)
    coluna = 1
    linha = LinhaCabecalho

    With ws
        While .Cells(linha, coluna).Value <> Empty
            Me.Campos.AddItem .Cells(linha, coluna)
            coluna = coluna + 1
        Wend
    End With
End Sub

Private Sub PreencheCabecalho(ByRef Lista())
    Dim ws As Worksheet
    Dim coluna As Integer
    Dim linha As Integer
    Set ws = ThisWorkbook.Worksheets(NomePlanilha)
    coluna = 1
    linha = LinhaCabecalho

    With ws
        While .Cells(linha, coluna).Value <> Empty
            Lista(coluna - 1, 0) = .Cells(linha, coluna)
            coluna = coluna + 1
        Wend
    End With
End Sub

Private Sub PreencheLista(ByVal TextoDigitado As String)
    Dim ws As Worksheet
    Dim I As Integer
    Dim x As Integer
    Dim indiceLista As Integer
    Dim coluna As Integer
    Dim TextoCelula As String
    Set ws = ThisWorkbook.Worksheets(NomePlanilha)
    Dim Lista()
    Application.ScreenUpdating = False
    ReDim Lista(ws.UsedRange.Columns.Count, 0)

    I = LinhaCabecalho + 1
    indiceLista = 1
    
    Call PreencheCabecalho(Lista)

    lstLista.Clear
    
    coluna = Me.Campos.ListIndex + 1
    
    With ws
        .Activate
        While .Cells(I, coluna) <> Empty
            TextoCelula = .Cells(I, coluna).Value
            If UCase(TextoCelula) Like "*" & UCase(TextoDigitado) & "*" Then

                For x = 0 To ws.UsedRange.Columns.Count - 1
                    ReDim Preserve Lista(ws.UsedRange.Columns.Count, indiceLista)
                    Lista(x, indiceLista) = .Cells(I, x + 1)
                Next

                indiceLista = indiceLista + 1
            End If
            I = I + 1
        Wend
    End With
   
    Lista = Array2DTranspose(Lista)

    Me.lstLista.List = Lista
    ThisWorkbook.Sheets("BDDADOS").Activate
    Application.ScreenUpdating = True
End Sub
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

Fico no aguardo.

Paulo Cezar.