Verificar duplicidade

[adesilva20]

Olá,

Pessoal, estou criando uma planilha no Excel com uma interface de registro.

O meu problema é que queria que antes das informações serem inseridas na planilha houvesse uma verificação para ver se já existe este cadastro.

O código do botão está abaixo:

Private Sub cmdGravar_Click()

'Ativar a primeira planilha
ThisWorkbook.Worksheets("CADASTROS").Activate

'Selecionar a célula A2
Range("A2").Select

'Procurar a primeira célula vazia
Do
If Not (IsEmpty(ActiveCell)) Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True

'Carregar os dados digitados nas caixas de texto para a planilha
ActiveCell.Value = txtNome.Value
ActiveCell.Offset(0, 1).Value = txtNascimento.Value
ActiveCell.Offset(0, 2).Value = txtMãe.Value
ActiveCell.Offset(0, 3).Value = cboPlano.Value
ActiveCell.Offset(0, 5).Value = txtCPF.Value
ActiveCell.Offset(0, 6).Value = txtRG.Value
ActiveCell.Offset(0, 7).Value = cboParentesco.Value
ActiveCell.Offset(0, 9).Value = cboSexo.Value
ActiveCell.Offset(0, 10).Value = cboEstado.Value
ActiveCell.Offset(0, 12).Value = txtEndereco.Value
ActiveCell.Offset(0, 13).Value = txtBairro.Value
ActiveCell.Offset(0, 14).Value = txtCidade.Value
ActiveCell.Offset(0, 15).Value = txtCEP.Value

'Limpar as caixas de texto
txtNome.Value = Empty
txtNascimento.Value = Empty
txtMãe.Value = Empty
cboPlano.Value = Empty
txtCPF.Value = Empty
txtRG.Value = Empty
cboParentesco.Value = Empty
cboSexo.Value = Empty
cboEstado.Value = Empty
txtEndereco.Value = Empty
txtBairro.Value = Empty
txtCidade.Value = Empty
txtCEP.Value = Empty

'Colocar o foco na primeira caixa de texto
txtCPF.SetFocus

End Sub

Então.. Queria saber onde certamente posso colocar o código de verificar duplicidade.. Já tentei usar depois de Range("A2").Select este código:


Dim r1 As Long
Dim r2 As Long


'Suponha que os controles do seu formulário chamam txtNome e txtCPF:
r1 = LinhaDe(Columns("A"), txtNome, Columns("F"), txtCPF)
r2 = LinhaDe(Columns("A"), txtNome, Columns("F"), txtCPF)

If r1 = 0 And r2 = 0 Then
	'OK, registro único
Else
	'r1 ou r2 é o número da linha que apresenta problema:
	If r1 > 0 Then MsgBox "A nova entrada conflita com a linha: " & r1
	If r2 > 0 Then MsgBox "A nova entrada conflita com a linha: " & r2
End If

End Sub

Se alguém souber uma forma mais fácil ou melhor fico grato.

[Wagner Morel]

adesilva20,

Bom dia!

Eu faria assim. Veja se lhe atende.

Private Sub cmdGravar_Click()
   'Cria variável contadora
   Dim i As Long

   'Cria variável para armazenar a última linha gravada na planilha Cadastros
   Dim UltimaLinha As Long

   'Cria variável booleana para checar se o CPF já existe
   Dim JáExiste As Boolean

   'Seta a variável booleana para falso
   JáExiste = False

   'Ativar a primeira planilha
   ThisWorkbook.Worksheets("CADASTROS").Activate

   'Armazena a última linha com dados da planilha Cadastros pela coluna A
   UltimaLinha = Sheets("CADASTROS").Cells(Cells.Rows.Count, 1).End(xlUp).Row

   'Laço para varrer toda a planilha pela coluna E (CPF)
   For i = 2 To UltimaLinha
    'Checa se o CPF que está tentando gravar já está gravado na planilha
    If Sheets("CADASTROS").Range("F" & i).Value = txtCPF.Text Then
	    MsgBox "Este CPF já está cadastrado!", vbCritical, "CADASTRO JÁ EXISTE"
	    JáExiste = True
	    Exit Sub
    End If
   Next

   'Se o cadastro não existir, prossegue com o código para cadastramento
   If JáExiste = False Then

    'Selecionar a célula A2
    Range("A2").Select

    'Procurar a primeira célula vazia
    Do
	    If Not (IsEmpty(ActiveCell)) Then
		    ActiveCell.Offset(1, 0).Select
	    End If
    Loop Until IsEmpty(ActiveCell) = True

    'Carregar os dados digitados nas caixas de texto para a planilha
    ActiveCell.Value = txtNome.Value
    ActiveCell.Offset(0, 1).Value = txtNascimento.Value
    ActiveCell.Offset(0, 2).Value = txtMãe.Value
    ActiveCell.Offset(0, 3).Value = cboPlano.Value
    ActiveCell.Offset(0, 5).Value = txtCPF.Value
    ActiveCell.Offset(0, 6).Value = txtRG.Value
ActiveCell.Offset(0, 7).Value = cboParentesco.Value
ActiveCell.Offset(0, 9).Value = cboSexo.Value
ActiveCell.Offset(0, 10).Value = cboEstado.Value
ActiveCell.Offset(0, 12).Value = txtEndereco.Value
ActiveCell.Offset(0, 13).Value = txtBairro.Value
ActiveCell.Offset(0, 14).Value = txtCidade.Value
ActiveCell.Offset(0, 15).Value = txtCEP.Value 

    'Limpar as caixas de texto
    txtNome.Value = Empty
    txtNascimento.Value = Empty
    txtMãe.Value = Empty
    cboPlano.Value = Empty
    txtCPF.Value = Empty
cboParentesco.Value = Empty
cboSexo.Value = Empty
cboEstado.Value = Empty
txtEndereco.Value = Empty
txtBairro.Value = Empty
txtCidade.Value = Empty
txtCEP.Value = Empty

    'Colocar o foco na primeira caixa de texto
    txtCPF.SetFocus

    MsgBox "Cadastro Realizado com Sucesso!", vbDefaultButton1, "CADASTRO"
   End If
End Sub