OreiaG

Para aplicar cada uma das três regras mantenha selecionado o intervalo A3:C8 / Formatação Condicional / Usar uma fórmula ... Para destacar o primeiro próximo vencimento utilize a fórmula abaixo, e para o segundo e o terceiro vencimentos, altere o número 1 no final da fórmula para 2 e para 3 respectivamente. =$B3=MENOR(SE($B$3:$B$8>HOJE();$B$3:$B$8);1) obs. o terceiro próximo vencimento é 28/01/25 e não 17/02/25 como você destacou manualmente na planilha.

Cole o código abaixo no módulo da planilha de interesse. Private Sub Worksheet_Change(ByVal Target As Range) Dim oldN As Double, newN As Double If Target.Address <> "$A$6" Or Target.Value = "" Then Exit Sub On Error GoTo fim Application.EnableEvents = False newN = Target.Value Application.Undo oldN = Target.Value Target.Value = oldN + newN fim: Application.EnableEvents = True End Sub ... atualiza para 122, digito 380 atualiza o valor para 302 ... A sua calculadora está precisando de aferição. O resultado deveria ser 502.

Desculpe, amigo. A cada postagem você traz uma novidade e um novo problema. Desisto de te ajudar!

Veja se o código abaixo faz TUDO o que você precisa. Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range If Target.Count > 1 Then Exit Sub 'Localizar "M1" em B If Target.Address = "$M$1" Then Set c = Range("B5:B" & Cells(Rows.Count, 2).End(3).Row).Find(Target.Value) If Not c Is Nothing Then c.Select Else: MsgBox "NÃO ENCONTRADO" Exit Sub End If 'Verifica se a entrada foi em B:C ou em G:H ou em K, a partir da linha 5 If Intersect(Target, Range("B:C,G:H,K:K")) Is Nothing Or Target.Row < 5 Then Exit Sub 'Se a entrada for um texto específico e em K If Target.Column = 11 And Target.Value = "CANCELOU PEDIDO S/DVL" Then Cells(Target.Row, "AK") = "PDD CANCEL " & Format(Target.Offset(, -1).Value, "dd/mm/yy") & " S/DVL" ElseIf Target.Column = 11 And Target.Value = "CANCELOU PEDIDO C/DVL" Then Cells(Target.Row, "AK") = "PDD CANCEL " & Format(Target.Offset(, -1).Value, "dd/mm/yy") & " C/DVL" End If 'Converte o texto em maiúsculas If Target.Value = UCase(Target.Value) Then Exit Sub Target.Value = UCase(Target.Value) End Sub

https://www.clubedohardware.com.br/forums/topic/1700149-vba-digitar-em-k-e-resultado-esperado-em-z/#comment-8811692 Experimente o código abaixo. Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("B:C,G:H,K:K")) Is Nothing Or Target.Row < 5 Then Exit Sub If Target.Value = UCase(Target.Value) Then Exit Sub Target.Value = UCase(Target.Value) End Sub

Olá, @jcgmcs. Experimente agradecer pela ajuda recebida. É rápido, demonstra boa civilidade, incentiva quem lhe ajudou a ajudá-lo novamente no futuro, e além de tudo isso, ainda é grátis.

Yes guy, here you go. Substitua as linhas correspondentes pelas novas linhas abaixo. Como você não mencionou sobre a coluna Z, considerei que ela será sempre em maiúsculas, independente da coluna K. If UCase(Target.Value) = "CANCELOU PEDIDO S/DVL" Then ... ElseIf UCase(Target.Value) = "CANCELOU PEDIDO C/DVL" Then

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row < 5 Or Target.Column <> 11 Then Exit Sub If Target.Value = "CANCELOU PEDIDO S/DVL" Then Cells(Target.Row, "Z") = "PDD CANCEL " & Format(Target.Offset(, -1).Value, "dd/mm/yy") & " S/DVL" ElseIf Target.Value = "CANCELOU PEDIDO C/DVL" Then Cells(Target.Row, "Z") = "PDD CANCEL " & Format(Target.Offset(, -1).Value, "dd/mm/yy") & " C/DVL" End If End Sub

Veja se ajuda. Simplifiquei e alterei o código Consec, assim o código Temporizador não é mais necessário. Coloquei intervalo de 5 segundos somente para efeitos dos seus testes, altere depois para 1 minuto, conforme o seu código original. Sub Consec() Cells(Rows.Count, "D").End(3)(2) = Cells(Rows.Count, "D").End(3) + 1 If Planilha1.CheckBox1 = True Then Application.OnTime (Now + TimeValue("00:00:05")), "Consec.Consec" End Sub E acrescente o código abaixo vinculado ao botão Parar. Private Sub CommandButton2_Click() Planilha1.CheckBox1 = False End Sub

Olá, @Elainekitty. Ocorre um erro e é informado que a macro Consec (nome da macro) não pode ser executada ... Para facilitar o entendimento e ajuda, anexe o seu arquivo Excel (imagens não ajudam) e informe exatamente em que situação o erro ocorre. Lembrando que para anexar arquivos com macro aqui no fórum, os arquivos devem estar compactados (zip, zipx, 7z) conforme está descrito abaixo.

Fala @deejaywesley. Parabéns pelas explicações e pelo arquivo anexado. Ficou super fácil para entender o que você quer. Apenas uma dica, não é necessário compactar arquivos sem macro para anexar aqui no fórum. Veja se o código abaixo faz o que você quer. Considerei que a Plan1 já estará convenientemente formatada (células, linhas e colunas). Sub Etiquetas() Dim wsO As Worksheet, wsD As Worksheet, r, k As Long, x As Long, v As Long, m As Long Set wsO = Sheets("Plan2"): Set wsD = Sheets("Plan1") If wsO.[A3] = "" Then Exit Sub wsD.Columns("A:F") = "" For k = 3 To wsO.Cells(Rows.Count, 1).End(3).Row With wsD .Cells(x + 1 + m, v + 1).Resize(4) = Application.Transpose([{"CÓDIGO:", "PREÇO:","QNTD:" , "PRODUTO:"}]) For Each r In Array(wsO.Cells(k, 1), wsO.Cells(k, 8), wsO.Cells(k, 7), wsO.Cells(k, 2)) .Cells(x + 1 + m, v + 2) = r: x = x + 1 Next r x = 0: v = v + 1 If v < 4 Then v = v + 1 Else: v = 0 x = 0: m = m + 5 End If End With Next k End Sub

Tentando ajudar: o erro pode ser porque o código Initialize do UserForm2 está referenciando ListBox1 que não existe naquele UserForm. Faça o teste após eliminar as duas linhas abaixo. ListBox1.ColumnCount = 4 ListBox1.ColumnWidths = "40 pt; 60 pt; 250 pt; 700 pt"

Utilize na Validação de Dados a lista de nomes retornada pela fórmula abaixo arrastada pela coluna. =SEERRO(ÍNDICE(B$4:B$44;MENOR(SE(I$4:I$44="ATIVO";LIN(B$1:B$41));LINS($A$1:A1)));"")