Excel Linhas repetidas no combobox

[Marcelo Lisboa Conde]

Como bloquear a repetição de várias linhas em uma combobox? A combobox está direto na célula e sempre que excluo um cadastro fica repetindo várias linhas do cadastro no final da lista após atualizar. E também quando incluo um cadastro a combobox fica vazia após finalizar a inclusão. Utilizo várias sub para completar o processo tais como: colocar em letra maiúscula, ordenar a coluna na aba do banco de dados, atualizar a combobox, criar ou excluir pasta no Windows explorer e salvar cadastro em PDF. Todos os processos são executados através da função Call na sub cadastrar ou excluir. No caso da inclusão fica como se estivesse em um Loop infinito, porém não tem nenhuma função Do while. Como posso solucionar estas 2 questões no VBA? Segue os comandos da sub cadastrar:

Private Sub CommandButton2_Click()
'
    ' botão Cadastrar
'
Application.ScreenUpdating = False
'
 Dim X, Y, Z, W, fso
 X = Range("I10").Value ' X recebe nome contido na célula "I10"
 Y = Range("E8").Value ' Y recebe o ano contido na célula "E8"
 Z = Range("F8").Value ' Z recebe o mês contido na célula "F8"
 W = Range("G8").Value ' Y recebe o dia contido na célula "G8"
'
X = Range("I10").Value ' X recebe nome contido na célula "I10"
'
If X = "" Then  'Rotina checa para ver se há nomes selecionados
'
    MsgBox "Nenhum nome informado. Processo abortado.", vbOKOnly, "CONTROLE DE ESCRITÓRIO JURÍDICO"
    Range("A1").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True  ' protege a planilha
    Exit Sub
'
End If
'
    Set fso = CreateObject("Scripting.FileSystemObject") 'Criar objeto
'
       If fso.FolderExists("D:\Controle Escritorio Juridico\" & X & " " & Y & "_" & Z & "_" & W) Then
    MsgBox "PASTA CLIENTE já existe. Utilize a opção de ATUALIZAR DADOS ou crie novo cadastro com data diferente da existente.", vbOKOnly, "CONTROLE DE ESCRITÓRIO JURÍDICO"
    Range("E10").Select
    Exit Sub
'
End If
'
    Call Uppercase
    Call Todas_PrimeirasLetras_Maius
    Call AdicCli
    Call AdicPCon
    Call AdicProces
    Call GravarDados
'
    Call CriarPastas
    Call SalvaEmPDF
'
    MsgBox "Cadastro finalizado com sucesso.", vbOKOnly, "CONTROLE DE ESCRITÓRIO JURÍDICO"
'
    Call LimpaDadosExcluidos
'
    cmbBusca.Value = ""
'
Application.ScreenUpdating = True
'
End Sub

e os comandos da sub excluir:

Private Sub btExcluir_Click()
'
    ' exclui dados do registro
'
Application.ScreenUpdating = False
'
Dim W As Worksheet
Dim Nome As String
'
Set W = Sheets("Registro")
'
    Sheets("Registro").Visible = True  ' reexibe planilha
    ActiveWindow.SmallScroll Down:=-6
    ActiveSheet.Unprotect  ' desprotege a planilha
'
Nome = Range("I10").Value
'
If Nome = "" Then  'Rotina checa para ver se há nomes selecionados
'
    MsgBox "Nenhum nome selecionado. Processo abortado.", vbOKOnly, "CONTROLE DE ESCRITÓRIO JURÍDICO"
    Range("A1").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True  ' protege a planilha
    Exit Sub
'
End If
'
    Dim Msg, Style, Title, Help, Ctxt, Response, MyString
        Msg = "Os dados do cliente selecionado serão APAGADOS definitivamente. CONFIRMA a exclusão?" ' Define a mensagem
        Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define os botões
        Title = "CONTROLE DE ESCRITÓRIO JURÍDICO" ' Define o título
        Response = MsgBox(Msg, Style, Title)
    If Response = vbYes Then ' O usuário escolheu Sim
        MyString = "Sim" ' Executa ação seguinte
'
    ActiveWorkbook.Save  ' salva arquivo antes de fechar
'
    Call Elimina_Pasta
'
W.Select
W.Range("C3").Select
'
Do While ActiveCell.Value <> ""
'
    If ActiveCell.Value = Nome Then
'
        Sheets("Registro").Select
        ActiveSheet.Unprotect  ' desprotege a planilha
        ActiveCell.EntireRow.Delete
        MsgBox "Cadastro excluído com sucesso.", vbOKOnly, "CONTROLE DE ESCRITÓRIO JURÍDICO"
        Exit Do
'
    End If
'
    ActiveCell.Offset(1, 0).Select
'
Loop
'
'    Call AtualizaCombo
    Call Ordenar
'
    Sheets("Registro").Visible = False  ' oculta planilha
'
    Sheets("Cadastro").Select
    Range("A1").Select
'
    cmbBusca.Value = ""
'
    Call LimpaDadosExcluidos
'
Application.ScreenUpdating = True
'
Else
    MyString = "Não" ' Nada é executado. Não salva
End If
'
End Sub

 

[RafaVillani]

Prezado @Marcelo Lisboa Conde, se você ainda busca uma solução para estas questões, por favor, disponibilize a planilha para download.

 

Abraços

 

RafaVillani

[Marcelo Lisboa Conde]

segue a planilha. Se puder ajudar veja por favor as macros de inclusão e  exclusão de cadastro. Sem querer abusar tem também a Private Sub Worksheet_Change que bato cabeça há 2 meses com essas 3 macros e não saio do lugar.

Desde já agradeço qualquer ajuda.

Controle_Escritorio_Juridico.zip

[Marcelo Lisboa Conde]

Desculpem insistir no assunto, mas alguém pode me ajudar com este problema?