Excel Somar valores e atualizar data por macro

[Jorge Silva Santos]

Eu tenho uma planilha que funciona com macro, você clica nos botões cadastrar e efetuar saída e eles criam a linha dos registros nas abas correspondentes.

Entretanto eu gostaria que em vez de um novo registro (uma nova alinha criada), elas somassem a um só registro referente ao mesmo Produto/Item e Nome do Responsável forem os mesmos.

Exemplo: Cadastrei 1 pneu para Joel e após uns 2 dias cadastrando outros produtos, cadastrei 2 pneus para Joel, então o valor de 1 fosse atualizado para 3 e a data do dia referente ao cadastro anterior fosse atualizado.

Se possível atualizando a Data de Entrada e Saída para a última data registrada.

Anexei minha planilha.

 

Caso a parte da Data não for possível, tudo remover a coluna. Agradeço muito se me auxiliarem, obrigado!

controle.zip

[Wendell Menezes]

@Jorge Silva Santos Boa noite,

 

Substitua o conteúdo da macro "cadastro" para:

 

    Dim ws      As Worksheet
    Dim LR      As Long
    Dim r       As Long
    Dim Update  As Boolean
    
    Set ws = Sheets("ENTRADA") 'Planilha de cadastro de Entrada
    
    With ws
    
        LR = .Cells(Rows.Count, "B").End(xlUp).Row
        
        For r = 5 To LR
            If .Cells(r, "B") <> "" And .Cells(r, "B") = Range("C5") Then
                If .Cells(r, "E") = Range("C8") Then
                    .Cells(r, "C") = .Cells(r, "C") + Range("C6") 'Somar Quantidade de Entrada
                    .Cells(r, "D") = Range("C7")
                    Update = True
                    Exit For
                End If
            End If
        Next
        
        If Update = False Then
            .Rows("5").Insert
            Range("C5:C9").Copy
            .Range("B5").PasteSpecial xlPasteValues, , , True
        End If
    
    End With

 

Se for isso que queria é só fazer o mesmo na macro "cadastro2", porém atualizando o nome da aba de cadastro.

[Jorge Silva Santos]

8 horas atrás, Wendell Menezes disse:

@Jorge Silva Santos Boa noite,

 

Substitua o conteúdo da macro "cadastro" para:

 

    Dim ws      As Worksheet
    Dim LR      As Long
    Dim r       As Long
    Dim Update  As Boolean
    
    Set ws = Sheets("ENTRADA") 'Planilha de cadastro de Entrada
    
    With ws
    
        LR = .Cells(Rows.Count, "B").End(xlUp).Row
        
        For r = 5 To LR
            If .Cells(r, "B") <> "" And .Cells(r, "B") = Range("C5") Then
                If .Cells(r, "E") = Range("C8") Then
                    .Cells(r, "C") = .Cells(r, "C") + Range("C6") 'Somar Quantidade de Entrada
                    .Cells(r, "D") = Range("C7")
                    Update = True
                    Exit For
                End If
            End If
        Next
        
        If Update = False Then
            .Rows("5").Insert
            Range("C5:C9").Copy
            .Range("B5").PasteSpecial xlPasteValues, , , True
        End If
    
    End With

 

Se for isso que queria é só fazer o mesmo na macro "cadastro2", porém atualizando o nome da aba de cadastro.

 

Ficou perfeito meu caro, exatamente o que eu queria, só que não consegui editar o código pra funcionar com a saída (acho que está puxando dos campos errados, você pode por favor me ajudar com o código da saída (cadastro2)

[Wendell Menezes]

@Jorge Silva Santos , substitua todo o conteúdo do Módulo 1 pelo script abaixo:

 

Sub Novo_Cadastro()
    'Novo_Cadastro Macro
    Sheets("CADASTRO").Select
    Range("C5").Select
End Sub
Sub Nova_Baixa()
    ' Nova_Baixa Macro
    Sheets("CADASTRO").Select
    Range("F5").Select
End Sub

Sub limpar_dados()
    ' limpar_dados Macro
    Range("Tabela1[Preenchimento]").ClearContents
    Range("C5").Select
End Sub
Sub limpar_dados2()
    ' limpar_dados2 Macro
    Range("Tabela13[Preenchimento]").ClearContents
    Range("F5").Select
End Sub

Sub cadastro()
    CADASTRAR Sheets("ENTRADA")
End Sub

Sub cadastro2()
    CADASTRAR Sheets("SAIDA")
End Sub


Function CADASTRAR(ByVal ws As Worksheet)

    Dim RefCol  As Long
    Dim LR      As Long
    Dim r       As Long
    Dim Update  As Boolean
    
    If ws.Name = "ENTRADA" Then
        RefCol = 3 'Coluna com as infos de Entrada
            ElseIf ws.Name = "SAIDA" Then
        RefCol = 6 'Coluna com as infos de Saída
    End If
    
    With ws
    
        LR = .Cells(Rows.Count, "B").End(xlUp).Row
        
        For r = 5 To LR
            If .Cells(r, "B") <> "" And .Cells(r, "B") = Cells(5, RefCol) Then
                If .Cells(r, "E") = Cells(8, RefCol) Then
                    .Cells(r, "C") = .Cells(r, "C") + Cells(6, RefCol) 'Somar Quantidade
                    .Cells(r, "D") = Cells(7, RefCol)
                    Update = True
                    Exit For
                End If
            End If
        Next
        
        If Update = False Then
            .Rows("5").Insert
            Range(Cells(5, RefCol), Cells(9, RefCol)).Copy
            .Range("B5").PasteSpecial xlPasteValues, , , True
        End If
    
    End With

End Function