Código para carregar somente o tipo da descrição escolhida.

[riberex00]

Em uma agenda de contatos, com duas ComboBox dependentes, sendo a 1ª) CmbTipo: Categoria, Cidade e Nome, e a 2ª) dependente, CmbDescrição da Categoria, da Cidade e do Nome, programei as ComboBox para serem carregadas, a primeira no evento “Open” e a segunda no evento “Change”. Agora eu preciso de um código que pesquise e mostre somente o tipo pesquisado. Por exemplo, se eu carregar a CmbTipo: com Categoria, na CmbDescrição aparecerão somente as categorias. Então, ao clicar em uma das categorias eu gostaria que fossem carregadas na tabela apenas as categorias escolhidas, ou então, somente as Cidades escolhidas, e assim por diante. Como poderia ser esse código? Obrigado a todos.

Private Sub Workbook_Open()
    Sheets("PESQUISAR").Select
    Sheets("PESQUISAR").CmbTipo.Clear
    Sheets("PESQUISAR").Range("L3").Select
    
    Do While ActiveCell.Value <> ""
        Sheets("PESQUISAR").CmbTipo.AddItem ActiveCell.Value
        ActiveCell.Offset(1, 0).Select
    Loop
    
    Sheets("PESQUISAR").CmbTipo.ListIndex = 0
    Sheets("PESQUISAR").Range("B11").Select
End Sub

Private Sub CmbTipo_Change()

    'Limpar ComboBox Descrição
    
    Sheets("PESQUISAR").Activate
    Sheets("PESQUISAR").CmbDescricao.Clear
    'Sheets("LISTAS").Activate
   
    'Selecionar célula para iniciar a busca dos dados
    
    If CmbTipo.Value = "Categoria" Then
        Range("N3").Select
    ElseIf CmbTipo.Value = "Cidade" Then
        Range("P3").Select
    Else
        Range("R3").Select
    End If
    
    'Adicionar itens na ComboBox
    
    Do While ActiveCell.Value <> ""
        CmbDescricao.AddItem ActiveCell.Value
        ActiveCell.Offset(1, 0).Select
    Loop
    
    'Deixar primeiro item selecionado
    
    Sheets("PESQUISAR").Activate
    Sheets("PESQUISAR").CmbDescricao.ListIndex = 0
    Sheets("PESQUISAR").Range("B11").Select
End Sub

 

[Alyson Ronnan Martins]

Boa tarde.

Tem um arquivo que possa postar para ajudar a exemplificar mais rápido?

[Alyson Ronnan Martins]

Serve sim. 
manda o link do GoogleDrive ou OneDrive com o arquivo agora. 

[Alyson Ronnan Martins]

Boa noite @riberex00

Foi criado o comando "PesquisaAvancada":

Public Sub PesquisarAvancado(Categoria As String, Valor As String)
Dim shBase            As Worksheet    'Planilha de base
Dim shPesq            As Worksheet    'Planilha para exibir dados da pesquisa
Dim lCategorias       As Long         'Linha para cabeçalho das categorias
Dim ultimaColunaBase  As Long         'Ultima coluna da tabela "base"
Dim ultimaLinhaBase   As Long         'Ultima linha da tabela "base"
Dim y                 As Long         'Variável para coluna do "FOR"
Dim x                 As Long         'Variável para linha do "FOR"
Dim novaLinhaPesquisa As Long         'Nova linha na planliha "Pesquisar"


Set shBase = Sheets("BASE_DADOS")
Set shPesq = Sheets("PESQUISAR")
lCategorias = 3
novaLinhaPesquisa = 11
ultimaColunaBase = shBase.Cells(lCategorias, Columns.Count).End(xlToLeft).Column
ultimaLinhaBase = shBase.Cells(Rows.Count, "A").End(xlUp).Row

'Idenfificar a coluna igual ao texto da categoria
For y = 1 To ultimaColunaBase Step 1
  If shBase.Cells(lCategorias, y).Value = UCase(Categoria) Then
    'Pesquisar em todas as linhas para verificar se o "Valor" é igual ao da célula
    For x = lCategorias + 1 To ultimaLinhaBase Step 1
      'Identificar as linhas que estejam com o mesmo valor
      If shBase.Cells(x, y).Value = Valor Then
        'Agora deve passar as informações para tabela pesquisa
        shPesq.Cells(novaLinhaPesquisa, "B").Value = shBase.Cells(x, "A").Value
        shPesq.Cells(novaLinhaPesquisa, "C").Value = shBase.Cells(x, "B").Value
        shPesq.Cells(novaLinhaPesquisa, "D").Value = shBase.Cells(x, "C").Value
        shPesq.Cells(novaLinhaPesquisa, "E").Value = shBase.Cells(x, "D").Value
        shPesq.Cells(novaLinhaPesquisa, "F").Value = shBase.Cells(x, "E").Value
        shPesq.Cells(novaLinhaPesquisa, "G").Value = shBase.Cells(x, "F").Value
        shPesq.Cells(novaLinhaPesquisa, "H").Value = shBase.Cells(x, "G").Value
        shPesq.Cells(novaLinhaPesquisa, "I").Value = shBase.Cells(x, "H").Value
        novaLinhaPesquisa = novaLinhaPesquisa + 1
      End If
    Next x
  End If
Next y

End Sub

Esse procedimento precisa receber o valor dos dois campos ComboBox que estão na planilha, por esse motivo ao clicar no botão ele passa a informação para o procedimento:

Public Sub ButtonPesquisar()
LimparPesquisa
PesquisarAvancada CmbTipo.Value, CmbDescricao.Value
End Sub

Antes de iniciar o processo de pesquisa foi colocado o procedimento para limpar a planilha de pesquisa:

Public Sub LimparPesquisa()
Dim uLinha As Long
uLinha = Cells(Rows.Count, "B").End(xlUp).Row
If uLinha > 10 Then
  Range("B11:I" & uLinha).ClearContents
End If
End Sub

Faz o teste para ver se funciona Planilha anexada no google drive

https://drive.google.com/file/d/1_RofueQevo92sxEuIGpfkwi2Z_y1dWB_/view?usp=sharing

[riberex00]

Serve esse?

Eu gostaria de ao escolher a cidade, por exemplo, fossem listados os contatos somente daquela cidade. Obrigado.

[riberex00]

Boa tarde, Alyson, segue link para acesso ao arquivo. https://drive.google.com/file/d/1KQaG-Ui1Wm3m097wGCRp4Wzt7xp-47ME/view?usp=share_link

Desculpe não ter enviado antes.

Minha intenção é criar um código que ao pesquisar um contato, sejam mostrados apenas os contatos da categoria, da cidade ou do nome pesquisado. Por exemplo: ao pesquisar cidade e escolher Caxambu apareçam somente os contados da cidade de Caxambu, com todos os seus campos ou, ao escolher a categoria Automóveis, apareçam somente os contatos da categoria Automóveis, com todos os seus campos.

Obrigado.

Carlos

[riberex00]

Valeu Alyson, vou testar e te dou um retorno.

[riberex00]

Funcionou direitinho Alyson. Obrigado pela ajuda.👍