Macro - excluir registros duplicados

[alinelimacampos]

:wub:Bom dia.

Gente, esse fórum já me salvou umas vezes e pretendo que me ajudem novamente.

É o seguinte: tenho uma planilha que insere pedidos individualmente (com campos código, produto, nº pedido, fornecedor, cliente, preço unit, total, comissão, etc). Fiz uma macro que, quando clico no botão "salvar" ela insere esses dados em uma outra planilha e vai criando um banco de dados.

Pois bem, o problema é que se eu inserir o pedido e clicar salvar duas vezes, por exemplo, os dados do pedido são inseridos duas vezes também. Isso vai me dar resultados irreais quando eu for fazer uma análise de produtos vendidos, p.ex.

Gostaria de saber se tem como, nessa mesma macro, ele buscar pelo número do pedido e retornar com um aviso do tipo "registro salvo com sucesso" ou se o nº pedido já tiver sido registrado retornar "pedido já cadastrado". A condição teria que ser o número do pedido vez que não possui mais de um pedido com a mesma numeração.

Aguardo ansiosamente. Desde já agradeço.

[RafaVillani]

Amiga Aline, segue o codigo:

Estou supondo que o codigo do pedido seja salvo na coluna A, e que na planilha de entrada dos dados o codigo sera digitado em a1

sub pedido ()

for l = 1 to 1000 este valor pode aumentar ou diminuir de acordo com sua necessidade

if plan1.cells(1,1) = plan2.cells(l,1) then

msgbox "Pedido ja cadastrado"

else

seu codigo

end if

next

endsub

Espero ter ajudado.

Abraços

RafaVillani

[alinelimacampos]

Rafa, desculpe, mas os meus loiros não me permitem, ainda, tratar a macro nesse formato, eu to começando a mexer com macros agora....eu sei mexer no excel de fato, mas com a linguagem to por fora......então onde insiro esse código?

[RafaVillani]

Aline voce ira colocar esta no botao salvar que voce criou.

Clique direito no botao salvar, e va em exibir codigo.

Para a ajudar ser da melhor forma possivel, post uma imagem de sua planilha.

Abraços

RafaVillani

[alinelimacampos]

Dá uma olhadinha nela ai.....

[RafaVillani]

Beleza Aline, explicar fica meio difícil, mas vou tentar, vamos la!

voce possui uma macro que salva os pedidos em uma outra planilha, para verificar se ja existe um nº de pedido cadastrado voce devera fazer a rotina que postei anteriormente.

Agora, como?

for l = 1 to 1000 este comando faz um loop nas 1000 primeiras linhas.

Pude notar que voce utilizou caixas de texto ou textbox, então, a verificaçao devera analisar o nº do pedido que for digito nesta caixa, comparando com os registros que existem na outra planilha.

if textbox1 = cells (l,1) then

msgbox "Pedido ja cadastrado" este comando verifica se existe o nº ja cadastrado, se houver, aparece a mensagem.

Apos este procedimento e so colocar o codigo da macro ja existente em sua planilha, ficando a estrutura assim:

for l = 1 to 1000

if textbox1 = plan2.cells(l,1) then

msgbox "Pedido ja cadastrado"

l=1001

else

seu codigo

end if

next

Se ainda houver duvidas post o codigo da sua macro e, se possivel, post uma imagem da planilha que contem os pedidos cadastrados.

Abraços

RafaVillani

[alinelimacampos]

Oi Rafa, desculpe a demora, é o seguinte, fiz o procedimento abaixo. Deu certo até o "Pedido já cadastrado!" Como eu te falei, não entendo nada da liguagem em si, mas adianto q está dando o seguinte erro: Eu não consigo mais inserir nada, todo o pedido diferente q eu coloco lá dá essa mensagem de pedido ja cadastrado. Gostaria da outra parte q eu te falei, daquele argumento de que se não tiver o pedido cadastrado ele retornar (quando salvar) a informação "Pedido cadastrado com sucesso" e de fato cadastrar. Esse argumento que eu coloquei travou a macro, agora ele nao cadastra mais nada...

Abaixo vai a depuração da macro.

No aguardo,

Grata,

Aline.

Sub LANÇAR_PEDIDOS_LANÇAR()

'

' LANÇAR_PEDIDOS_LANÇAR Macro

'

'for l = 1 to 1000

If textbox1 = Plan2.Cells(5, 3) Then

MsgBox "Pedido já cadastrado!"

l = 2001

Else

Application.Goto Reference:="PEDIDOS_LANÇAMENTO"

Selection.Copy

Sheets("BDPEDIDO").Select

Range("A2").Select

Selection.Insert Shift:=xlDown

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

ActiveWindow.SmallScroll Down:=-3

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _

Formula1:="=0"

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

With Selection.FormatConditions(1).Borders(xlLeft)

.LineStyle = xlContinuous

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.FormatConditions(1).Borders(xlRight)

.LineStyle = xlContinuous

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.FormatConditions(1).Borders(xlTop)

.LineStyle = xlContinuous

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.FormatConditions(1).Borders(xlBottom)

.LineStyle = xlContinuous

.TintAndShade = 0

.Weight = xlThin

End With

Selection.FormatConditions(1).StopIfTrue = False

Rows("35:35").Select

With Selection.Interior

.PatternColorIndex = xlAutomatic

.Color = 10092543

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

Application.Goto Reference:="BDPEDIDOS_QTDE"

Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _

SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

ReplaceFormat:=False

Selection.SpecialCells(xlCellTypeBlanks).Select

Selection.EntireRow.Delete

Range("A1").Select

Sheets("PEDIDOS").Select

ActiveWindow.SmallScroll Down:=-12

ActiveWindow.ScrollRow = 75

ActiveWindow.ScrollRow = 73

ActiveWindow.ScrollRow = 71

ActiveWindow.ScrollRow = 69

ActiveWindow.ScrollRow = 65

ActiveWindow.ScrollRow = 62

ActiveWindow.ScrollRow = 58

ActiveWindow.ScrollRow = 54

ActiveWindow.ScrollRow = 51

ActiveWindow.ScrollRow = 45

ActiveWindow.ScrollRow = 41

ActiveWindow.ScrollRow = 35

ActiveWindow.ScrollRow = 30

ActiveWindow.ScrollRow = 21

ActiveWindow.ScrollRow = 18

ActiveWindow.ScrollRow = 16

Range("B17").Select

ActiveWorkbook.Save

End If

End Sub

[RafaVillani]

Bom dia Aline, vamos por partes.

* Sempre da a mensagem "Pedido ja cadastrado"

Isso está acontecendo porque voce esta analisando somente a celula C5, note que em sua macro voce colocou: If textbox1 = Plan2.Cells(5, 3), ou seja, linha 5 coluna 3, onde, na verdade, deveria estar com a variavel L, que é a variável do comando for.

Hoje tive tempo para analisar seu código, acho que com este seu problema será resolvido.

pedido = 0

For l = 5 To 1000

If Plan1.TextBox1.Text = Plan2.Cells(l, 3) Then

pedido = Plan2.Cells(l, 3)

l = 1001

End If

Next

If pedido = 0 Then

Application.Goto Reference:="PEDIDOS_LANÇAMENTO"

Selection.Copy

Sheets("BDPEDIDO").Select

Range("A2").Select

Selection.Insert Shift:=xlDown

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

ActiveWindow.SmallScroll Down:=-3

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _

Formula1:="=0"

Selection.FormatConditions(Selection.FormatConditi ons.Count).SetFirstPriority

With Selection.FormatConditions(1).Borders(xlLeft)

.LineStyle = xlContinuous

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.FormatConditions(1).Borders(xlRight)

.LineStyle = xlContinuous

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.FormatConditions(1).Borders(xlTop)

.LineStyle = xlContinuous

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.FormatConditions(1).Borders(xlBottom)

.LineStyle = xlContinuous

.TintAndShade = 0

.Weight = xlThin

End With

Selection.FormatConditions(1).StopIfTrue = False

Rows("35:35").Select

With Selection.Interior

.PatternColorIndex = xlAutomatic

.Color = 10092543

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

Application.Goto Reference:="BDPEDIDOS_QTDE"

Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _

SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

ReplaceFormat:=False

Selection.SpecialCells(xlCellTypeBlanks).Select

Selection.EntireRow.Delete

Range("A1").Select

Sheets("PEDIDOS").Select

ActiveWindow.SmallScroll Down:=-12

ActiveWindow.ScrollRow = 75

ActiveWindow.ScrollRow = 73

ActiveWindow.ScrollRow = 71

ActiveWindow.ScrollRow = 69

ActiveWindow.ScrollRow = 65

ActiveWindow.ScrollRow = 62

ActiveWindow.ScrollRow = 58

ActiveWindow.ScrollRow = 54

ActiveWindow.ScrollRow = 51

ActiveWindow.ScrollRow = 45

ActiveWindow.ScrollRow = 41

ActiveWindow.ScrollRow = 35

ActiveWindow.ScrollRow = 30

ActiveWindow.ScrollRow = 21

ActiveWindow.ScrollRow = 18

ActiveWindow.ScrollRow = 16

Range("B17").Select

ActiveWorkbook.Save

MsgBox ("Pedido cadastrado com sucesso!")

Else

MsgBox ("Pedido já cadastrado: " & pedido & "!")

End If

End Sub

Testa agora e olha se da certo, se não der, disponibiliza sua planilha para download no www.sendspace.com, e post o link, assim fica mais fácil te ajudar.

Abraços

RafaVillani

[alinelimacampos]

Bom dia Rafa, desculpe a ignorância, mas eu coloquei exatamente o código q me mandou e deu erro....dá uma olhadinha nela ai: http://www.sendspace.com/file/3fnxd2... aguardo notícias.

[RafaVillani]

Aline, desculpe a demora, segue a planilha, veja se lhe atende.

http://www.sendspace.com/file/4n5zbt

Abraços

RafaVillani

[alinelimacampos]

Perfeito.

Resolvido.

Valeu mesmo rafa.

Grata

[Flavio Soares]

Caso o autor do tópico necessite, o mesmo será reaberto, para isso deverá entrar em contato com a moderação solicitando o desbloqueio.