Não compreendi, poderia dar mais detalhes:

Teremos outro botão para pesquisar ou, apos preencher o listbox1 executar a pesquisa automática ?
Qual o Critério de pesquisa para preencher o Listbox2 ?

[]s

Olá Mauro boa noite,

Não haverá outro botão não. O formulário é esse mesmo, sem mudar nada.

Eu até consegui chegar ao que pretendo, mas dá um erro no final.

Basicamente a rotina que preciso é a BUSCAMUSIC. Ela precisa verificar a segunda coluna do Listbox1 (nome da música) e procurar na planilha BDMUS quem são os autores. Dessa forma, o resultado (todos os autores) irão aparecer no Listbox2. Detalhe, são várias músicas, ou seja precisa ser feita a varredura de todos autores da Musica1, depois todos os autores da Música2 e assim por diante.

A rotina que comentei ter chegado perto, mas que dá um erro ao final (Erro 381), ficou assim:

Public Sub BUSCAMUSIC()
On Error GoTo Werro
 
   Dim i As Variant
   Dim j As Variant
    Dim sLin
    
    Dim Plan As Worksheet

    Dim lastCOL As Variant
    Dim mais As Integer
    Dim linha As Integer
    Dim list As Variant

    Set Plan = Sheets("BDMUS")

    i = 2
    line = 0
    'list = 1
    mais = 1

    'Conta os Itens no ListBox
    sLin = FLOCA.ListBox2.ListCount
    
    If sLin = 0 Then 'Se ListBox Vazio, Linha = 0
        linha = 0
    Else
        linha = sLin 'Se não Linha = Contagem
    End If

    j = 3
    
    With Plan

       lastCOL = 50 '.Cells(i, Columns.Count).End(xlToLeft).Column

    End With

    While Plan.Cells(i, 2).Value <> vbNullString
        If Plan.Range("B" & i).Value = ListBox1.list(line, 1) Then
            For j = 3 To lastCOL Step 4
            If Plan.Cells(i, j) <> vbNullString Then
                FLOCA.ListBox2.AddItem Plan.Cells(i, j)
                FLOCA.ListBox2.list(linha, 1) = Plan.Cells(i, j + 1)
              
            linha = linha + 1
           
            End If
            Next j
             i = 0
            line = line + 1
            
        End If
        i = i + 1
        
        j = 3
        
    Wend

Exit Sub
Werro:
    TrataErro Err.Number, Err.Description
End Sub

Guima, vamoso ver se entendi corretamente.

Utilizando a dica e o modelo que postei no link abaixo referente a uma Function de Pesquisa desenvolvida pelo Tomaz e que adaptei podendo ser utilizada para varios tipos de valores :

Function Pesquisar InputBox e TextBox
viewtopic.php?f=21&t=2877

Adaptei para seu modelo da seguinte forma :

Adicione um Modulo e cole :

Public sLocaliza As Boolean

Public Function ProcuraRefId(ByVal RefId As String) As String
    Dim iLin As Long
    Dim sCol As Long
    
    sLocaliza = False

    Dim wsDados As Worksheet
    Set wsDados = Worksheets("BDMUS")
    
    iLin = 2 'Linha 2
    sCol = 2 'Coluna 1
    
    With wsDados
    
        Do While Not IsEmpty(.Cells(iLin, sCol))

            If .Cells(iLin, sCol).Value = RefId Then
             
                sLocaliza = True 'Verdadeiro se encontrado
                
                Exit Do 'Sai do Loop se encontrar
            
            End If
            
            'Incrementa a linha
            iLin = iLin + 1
            
        Loop
        
    End With

End Function

Substitua a sua rotina BUSCAMUSIC pela a abaixo :

Public Sub BUSCAMUSIC()
'On Error GoTo Werro
 
   Dim i As Variant
   Dim j As Variant
   Dim xLin As Variant
   
    Dim sLin
    
    Dim sLin2
    Dim RefId As String
    
    Dim PlanMUS As Worksheet

    Dim lastCOL As Variant
    Dim mais As Integer
    Dim linha As Integer

    Set PlanMUS = Sheets("BDMUS")

    i = 2
    mais = 1

    'Conta os Itens no ListBox
    sLin = FLOCA.ListBox2.ListCount
    
    If sLin = 0 Then 'Se ListBox Vazio, Linha = 0
        linha = 0
    Else
        linha = sLin 'Se não Linha = Contagem
    End If

    j = 3
    
    With PlanMUS

       lastCOL = 50 '.Cells(i, Columns.Count).End(xlToLeft).Column

    End With


    xLin = 0
    
    sLin2 = FLOCA.ListBox1.ListCount

    While sLin2 > xLin
     
        RefId = ListBox1.List(Line, 1)
    
            'Chama a Function de Pesquisa
            ProcuraRefId (RefId)
        
            For j = 3 To lastCOL Step 4
                If PlanMUS.Cells(i, j) <> vbNullString Then
                    FLOCA.ListBox2.AddItem PlanMUS.Cells(i, j)
                    FLOCA.ListBox2.List(linha, 1) = PlanMUS.Cells(i, j + 1)
                  
                    linha = linha + 1
                    Line = 0
                
                End If
            
            Next j
            
            Line = Line + 1
            
            sLin2 = sLin2 - 1
            
            i = i + 1
        
        j = 3
    Wend

Exit Sub

Werro:
    TrataErro Err.Number, Err.Description
End Sub

A adaptação foi meio as pressas, faça os testes e veja se é isto, e se for preciso de uma limpada que acho que temos variáveis que acabaram se anulando.

[]s

UAU !!!!!!

Formidável Mauro. Era isso mesmo, mas sinceramente, não ainda não consegui entender a rotina, se tiver um tempinho depois me explica.

Valeu

Guima, estou com um problema parecido, pode disponibilizar sua planilha para analise?

Abraços!

Bom dia!!
A mesma está na 1º postagem do Guima.

Você tentou e não conseguiu baixar???

Eu baixei, e atualizei a rotina BUSCAMUSIC conforme indicado e apresentou erro.
Pensei que ele havia corrigido e não tinha postado novamente. Baixei e testei direto, está funcionando mesmo. Valeu!

Cheguei um pouco tarde, mas como o Alexandre disse a planilha tá no primeiro post. E os créditos da resolução são todos do Mauro.

Abraço

Boa noite Pessoal,

Mauro fiquei tão impressionado com a solução que havia me proposto que nem fiz questão de checar os dados. Hoje que percebi que ela não está filtrando os dados corretamente.

Estou colocando o arquivo em anexo, faça a seleção da seguinte forma:

- Digite "2". Irá aparecer o Álbum "Novos Rumos". Teoricamente irá filtrar apenas a música "LOUCO AMOR" no LISTBOX1.

-Por sua vez o Listbox procuraria o valor da primeira coluna de cada linha do LISTBOX1. Se houvesse valor igual seria filtrado no Listbox2, teoricamente filtraria apenas PIO DA COSTA, porém é filtrado algo totalmente diferente disso.

Espero que compreenda o que tentei explicar.

Abraço

Guima, aqui no serviço não tenho o excel 2007, mas analisando as rotinas que passei, reparei que cometi um lapso, hehehehe, acontece, mas ajuste conforme abaixo e faça os testes.

Antes, verifique se as referencias ás colunas estão corretas, principalmente a da Function, sCol = 2, se não me engano os valores estavam na Col 2.

Se colocou a Function ProcuraRefId no mesmo modulo do formulário, ajuste a variável nas linhas abaixo na Sub BUSCAMUSIC :

FLOCA.ListBox2.AddItem PlanMUS.Cells(i, j)
FLOCA.ListBox2.List(linha, 1) = PlanMUS.Cells(i, j + 1)

para
FLOCA.ListBox2.AddItem PlanMUS.Cells(iLin, J)
FLOCA.ListBox2.List(Linha, 1) = PlanMUS.Cells(iLin, J + 1)

Explicando, iLin é o retorno da Function, ou seja, a linha onde foi encontrada a pesquisa, então é ela que temos de usar.

Faça os testes, uma vez que me basiei só pelas rotinas, sem ver o exemplo, e qq duvida retorne.

[]s

Boa Tarde Mauro,

Anteriormente a a Function ProcuraRefId ficava num módulo separado, coloquei ambas rotinas no mesmo módulo conforme sugerido por você. Porém se deixar dessa forma retorna o erro em tempo de execução 1004.

Fiz uma pequena alteração e declarei iLin dentro da rotina BUSCAMUSIC, ai o código roda, porém continuou filtrando errado. Mudei a varíavel sCOL e de nada adiantou. Declarei ela como 1 e 2, continuo filtrando de forma equivocada.

Brigadão pela força

Guima, se antes a Function estava em um modulo separado e funcionava, então tire-a do formulário, coloque a novamente no Modulo, tenha certeza de sCol estar como 2.

Veja que na Declartação temos
Option Explicit

Public sLocaliza As Boolean
'Acrescente esta
Public iLin As Long

Na Sub BUSCAMUSIC, deixe como a que eu póstei anteriormente, só alterando :
para
FLOCA.ListBox2.AddItem PlanMUS.Cells(iLin, J)
FLOCA.ListBox2.List(Linha, 1) = PlanMUS.Cells(iLin, J + 1)

Não declare novamente iLin nesta Rotina.

Se não dser certo, terei de ver seu arquivo, mas isto só mais tarde.

[]s

Ok Mauro,

Fiz os testes, mas o erro permanece. Inclusive não havia citado antes, mas o erro esta na rotina BUSCAMUSIC e na linha onde está a variável iLin. Só não ocorre quando declaro ela dentro da rotina BUSCAMUSIC, porém são filtrados os dados errados. E realizei os testes colocando a FUNCTION num módulo separado e dentro do Formulário, juntamente com a BUSCAMUSIC, mas em ambos o erro foi o mesmo.

Agradeço a força, Mauro.

Guima, me baseando em seu anexo do post anterior, eu fiz exatamente o que lhe indiquei e funcionou.

Passo a Passo :
Eu fiz a Obs :
1 ) - Na Function Antes, verifique se as referencias ás colunas estão corretas, principalmente a da Function, sCol = 2, se não me engano os valores estavam na Col 2.
Em seu anexo está : sCol = 1

2 ) - Veja que na Declartação temos
Option Explicit - Em seu modelo não tem, mas pode deixar sem, se colocar terá que Declararr todas as Variáveis

Public sLocaliza As Boolean
'Acrescente esta
Public iLin As Long

3 ) - Não declare novamente iLin nesta Rotina.
E a Function em seu anexo tem esta declaração :
Public Function ProcuraRefId(ByVal RefId As String) As String
Dim iLin As Long - Ela gera o erro por estar repetida
Dim sCol As Long

3 ) Na Sub BUSCAMUSIC, deixe como a que eu póstei anteriormente, só alterando :
para
FLOCA.ListBox2.AddItem PlanMUS.Cells(iLin, J)
FLOCA.ListBox2.List(Linha, 1) = PlanMUS.Cells(iLin, J + 1)

As alterações foram realizadas com a Function em Módulo separado, veja o resultado abaixo :

Siga os passos e qq coisa retorne.

[]s