Tópicos relacionados a códigos VBA, gravação de macros, etc.
#61456
minha macro abaixo não faz uma das tarefas, que é ver os valores da aba Data - coluna AV, se existe na aba Week Update - coluna AK, e caso só exista da aba Data, então o respectivo valor na Coluna AT, mudar para "Historical"

https://drive.google.com/file/d/16Z6Vga ... sp=sharing
Código: Selecionar todos
Sub DataUpdate()
   Dim Dary As Variant, Hary As Variant, Uary As Variant, Nary As Variant, Nhary As Variant
   Dim i As Long, c As Long, UsdRws As Long, nr As Long
   Dim Dic As Object
   
   Application.ScreenUpdating = False
   Worksheets("Data").Unprotect Password:="Henkel2020"
   

   Set Dic = CreateObject("scripting.dictionary")
   
   With Sheets("Week Update")
      UsdRws = .Range("C" & Rows.Count).End(xlUp).Row
      Uary = .Range("A3:AK" & UsdRws)
   End With
   
   With Sheets("Data")
      UsdRws = .Range("C" & Rows.Count).End(xlUp).Row
      Dary = .Range("AV3:AV" & UsdRws).Value2
      Hary = .Range("AT3:AT" & UsdRws).Value2
   End With
   
   For i = 1 To UBound(Dary)
      Dic(Dary(i, 1)) = i
   Next i
   
   With Sheets("Data")
      Dary = .Range("A3:AJ" & UsdRws).Value2
   End With
   
   ReDim Nary(1 To UBound(Uary), 1 To 36)
   For i = 1 To UBound(Uary)
      If Dic.Exists(Uary(i, 37)) Then
      
         For c = 1 To 36
            Dary(Dic(Uary(i, 37)), c) = Uary(i, c)
         Next c
   
         If Hary(Dic(Uary(i, 37)), 1) = "Historical" Then Hary(Dic(Uary(i, 37)), 1) = ""
       
      Else

         nr = nr + 1
         For c = 1 To 36
            Nary(nr, c) = Uary(i, c)
         Next c
         
         Hary(i, 1) = "Historical"  ' what there are in "Data" but do not exists on "Week Update", the value is not changed to "Historical"
         
      End If
   Next i
   
   With Sheets("Data")
      
      .Range("A3:AJ" & UsdRws).Value = Dary
      .Range("AT3:AT" & UsdRws).Value = Hary
      If nr > 0 Then
         .Range("A" & UsdRws + 1).Resize(nr, 36).Value = Nary
      End If
   End With
  
  Sheets("Week Update").ListObjects(1).DataBodyRange.EntireRow.Delete
  Sheets("Week Update").Range("Update[Document NumberDocument Line Number]") = "=[@[Document Number]]&[@[Document Line Number]]"
  
  Worksheets("Data").Protect Password:="Henkel2020", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, UserInterfaceOnly:=True

  Worksheets("Data").EnableOutlining = True
  
  Application.ScreenUpdating = True
    
End Sub
#61459
Sugestão: disponibilize o arquivo Excel diretamente aqui no fórum, assim evitará trabalho adicional para quem quiser baixar o arquivo, além do risco de vírus.
#61464
October_2020_Updated.xlsm
Bom dia @osvaldomp !! Feliz Ano novo :)

Desculpe, é que o arquivo era muito grande. Trabalhei nele agora para diminuir, e já deixei as linhas para checagem filtradas.
Te agradecerei muito se conseguir me ajudar (não consegui nem dormir a noite rs).

Desde já, muito muito obrigada !
Você não está autorizado a ver ou baixar esse anexo.
#61466
Feliz Ano Novo pra você também! :)
O código abaixo atende ao que você comentou no primeiro post.
O resultado do código será este ~~~> na planilha Data as células AT1381, AT1615 e AT1616 serão preenchidas com Historical#e a célula AT1786 não será preenchida.
Considerei que o Auto Filtro estará aplicado ao rodar o código, como está no seu exemplo, no entanto é possível incluir no código os comandos para aplicar o Auto Filtro, se você quiser.
Não considerei o código existente no seu exemplo.
Código: Selecionar todos
Sub BuscaDados()
 Dim Doc As Range
  With Sheets("Data")
   .Protect "Henkel2020", UserInterFaceOnly:=True
   For Each Doc In .Range("AV3:AV" & Cells(Rows.Count, 48).End(3).Row).SpecialCells(xlVisible)
    If Application.CountIf(Sheets("Week Update").[AK:AK], Doc.Value) = 0 Then .Cells(Doc.Row, "AT") = "Historical"
   Next Doc
  End With
End Sub
#
obs.
1. me parece que na planilha Data todas as células estão desbloqueadas então mesmo com a planilha protegida qualquer célula poderá ter seu valor alterado, ou seja, proteger a planilha não surte qualquer efeito.
2. verifique na planilha Data, coluna AR, está aplicada Validação de Dados desnecessária até a última linha da planilha, isso pode sobrecarregar a planilha.
#61469
Você pode "chamar" o código que passei a partir do seu código existente, basta colocar o nome do código na parte adequada do seu código:

'parte do seu código
...
BuscaDados
...
'mais do seu código

Se você tiver dificuldade então descreva o que você quer fazer na totalidade e aí elaboramos outro código para substituir o existente, é menos trabalhoso fazer um novo.
#61473
Olá, testei aqui !

Eu deixei filtrada e exclui muitas linhas para conseguir postar o arquivo aqui, o que estava no link é o original.
Testei seu código e aparentemente funcional, chamando pelo código que já estava pronto, porém sem os filtros demora MUITO para rodar.
o código já pronto demora menos do que 5 segundos.

o que preciso, em si é:

Ela checa se o valor da coluna AV na aba Data existe na coluna AK da aba Week Update

1 - se não existe o valor na Week UPdate, então substitui o valor da coluna AT aba Data com o valor "Historical", na linha correspondente

2 - Se existe, e o valor atual na coluna AT de Data é Historical, então substitui por vazio

3 - SE existe, e o valor da coluna ATnão é igual a "Historical, então permanece tudo como está;

4 - Se o valor existe só na aba Week Update, então adiciona o intervalo de A - AJ na aba Data;

enquanto eu escrevia aqui, até agora a tabela está travada - rodando o codigo que me passou no já existente;
#61474
osvaldomp escreveu: 13 Jan 2021 às 11:15 Feliz Ano Novo pra você também! :)
O código abaixo atende ao que você comentou no primeiro post.
O resultado do código será este ~~~> na planilha Data as células AT1381, AT1615 e AT1616 serão preenchidas com Historical#e a célula AT1786 não será preenchida.
Considerei que o Auto Filtro estará aplicado ao rodar o código, como está no seu exemplo, no entanto é possível incluir no código os comandos para aplicar o Auto Filtro, se você quiser.
Não considerei o código existente no seu exemplo.
Código: Selecionar todos
Sub BuscaDados()
 Dim Doc As Range
  With Sheets("Data")
   .Protect "Henkel2020", UserInterFaceOnly:=True
   For Each Doc In .Range("AV3:AV" & Cells(Rows.Count, 48).End(3).Row).SpecialCells(xlVisible)
    If Application.CountIf(Sheets("Week Update").[AK:AK], Doc.Value) = 0 Then .Cells(Doc.Row, "AT") = "Historical"
   Next Doc
  End With
End Sub
#
obs.
1. me parece que na planilha Data todas as células estão desbloqueadas então mesmo com a planilha protegida qualquer célula poderá ter seu valor alterado, ou seja, proteger a planilha não surte qualquer efeito.
2. verifique na planilha Data, coluna AR, está aplicada Validação de Dados desnecessária até a última linha da planilha, isso pode sobrecarregar a planilha.
1 - Eu deixei desbloqueada para não ter problema nos testes;
2 - Como você sugere que seja aplicado só quando as novas linhas forem adicionadas ? pq tem que aperecer dai;
#61476
teixeire escreveu: 13 Jan 2021 às 13:35 Eu deixei filtrada e exclui muitas linhas para conseguir postar o arquivo aqui, o que estava no link é o original.
Se o arquivo for grande ele precisa ser compactado para anexar aqui.

Testei seu código e aparentemente funcional, chamando pelo código que já estava pronto, porém sem os filtros demora MUITO para rodar.
Sim, no seu exemplo com o Auto Filtro aplicado o código analisa somente 4 células, porém sem o Filtro ele analisa 1780+ células, por isso o tempo é bem maior. Se o seu código atual aplica o Auto Filtro então chame o novo código depois do filtro aplicado, se não, como eu sugeri antes, passe o(s) critério(s) para aplicar o Auto Filtro, assim incluiremos no código que passei os comandos para filtrar.

o que preciso, em si é:
Isso que você descreveu é o que faz o código que passei, com exceção do item 2, que você não comentou antes e que eu incluí no código abaixo, coloque esse no lugar do anterior.
No entanto, o que eu quis dizer na mensagem anterior é que se você não conseguir rodar o código que passei associado ao existente, então nos informe com exatidão o que você quer fazer (ou o que o seu código atual faz) assim poderemos elaborar um novo código a aí já incorporando o que passei.


enquanto eu escrevia aqui, até agora a tabela está travada - rodando o codigo que me passou no já existente;
Não entendi.

1 - Eu deixei desbloqueada para não ter problema nos testes;
É recomendável manter as formatações originais no arquivo anexado.

2 - Como você sugere que seja aplicado só quando as novas linhas forem adicionadas ? pq tem que aperecer dai;
Por tratar- se Tabela Excel então ao iniciar uma nova linha, manualmente ou via macro, o Excel "puxa" automaticamente fórmulas e formatos para a nova linha, não é necessário "esticar" formatos para além da Tabela já prevendo o seu crescimento futuro.
Código: Selecionar todos
Sub BuscaDados()
 Dim Doc As Range
  With Sheets("Data")
   .Protect "Henkel2020", UserInterFaceOnly:=True
   For Each Doc In .Range("AV3:AV" & Cells(Rows.Count, 48).End(3).Row).SpecialCells(xlVisible)
    If Application.CountIf(Sheets("Week Update").[AK:AK], Doc.Value) = 0 Then
     .Cells(Doc.Row, "AT") = "Historical"
    ElseIf .Cells(Doc.Row, "AT") = "Historical" Then
     .Cells(Doc.Row, "AT") = ""
    End If
   Next Doc
  End With
End Sub
#61477
osvaldomp escreveu: 13 Jan 2021 às 14:41
teixeire escreveu: 13 Jan 2021 às 13:35 Eu deixei filtrada e exclui muitas linhas para conseguir postar o arquivo aqui, o que estava no link é o original.
Se o arquivo for grande ele precisa ser compactado para anexar aqui.

Testei seu código e aparentemente funcional, chamando pelo código que já estava pronto, porém sem os filtros demora MUITO para rodar.
Sim, no seu exemplo com o Auto Filtro aplicado o código analisa somente 4 células, porém sem o Filtro ele analisa 1780+ células, por isso o tempo é bem maior. Se o seu código atual aplica o Auto Filtro então chame o novo código depois do filtro aplicado, se não, como eu sugeri antes, passe o(s) critério(s) para aplicar o Auto Filtro, assim incluiremos no código que passei os comandos para filtrar.

o que preciso, em si é:
Isso que você descreveu é o que faz o código que passei, com exceção do item 2, que você não comentou antes e que eu incluí no código abaixo, coloque esse no lugar do anterior.
No entanto, o que eu quis dizer na mensagem anterior é que se você não conseguir rodar o código que passei associado ao existente, então nos informe com exatidão o que você quer fazer (ou o que o seu código atual faz) assim poderemos elaborar um novo código a aí já incorporando o que passei.


enquanto eu escrevia aqui, até agora a tabela está travada - rodando o codigo que me passou no já existente;
Não entendi.

1 - Eu deixei desbloqueada para não ter problema nos testes;
É recomendável manter as formatações originais no arquivo anexado.

2 - Como você sugere que seja aplicado só quando as novas linhas forem adicionadas ? pq tem que aperecer dai;
Por tratar- se Tabela Excel então ao iniciar uma nova linha, manualmente ou via macro, o Excel "puxa" automaticamente fórmulas e formatos para a nova linha, não é necessário "esticar" formatos para além da Tabela já prevendo o seu crescimento futuro.
Código: Selecionar todos
Sub BuscaDados()
 Dim Doc As Range
  With Sheets("Data")
   .Protect "Henkel2020", UserInterFaceOnly:=True
   For Each Doc In .Range("AV3:AV" & Cells(Rows.Count, 48).End(3).Row).SpecialCells(xlVisible)
    If Application.CountIf(Sheets("Week Update").[AK:AK], Doc.Value) = 0 Then
     .Cells(Doc.Row, "AT") = "Historical"
    ElseIf .Cells(Doc.Row, "AT") = "Historical" Then
     .Cells(Doc.Row, "AT") = ""
    End If
   Next Doc
  End With
End Sub
Oi ouvaldo, eu já tinha enviado, segue abaixo:

Olá, testei aqui !



Eu deixei filtrada e exclui muitas linhas para conseguir postar o arquivo aqui, o que estava no link é o original.
Testei seu código e aparentemente funcional, chamando pelo código que já estava pronto, porém sem os filtros demora MUITO para rodar.
o código já pronto demora menos do que 5 segundos.

o que preciso, em si é:

Ela checa se o valor da coluna AV na aba Data existe na coluna AK da aba Week Update

1 - se não existe o valor na Week UPdate, então substitui o valor da coluna AT aba Data com o valor "Historical", na linha correspondente

2 - Se existe, e o valor atual na coluna AT de Data é Historical, então substitui por vazio

3 - SE existe, e o valor da coluna ATnão é igual a "Historical, então permanece tudo como está;

4 - Se o valor existe só na aba Week Update, então adiciona o intervalo de A - AJ na aba Data;


Obs.: não existe critério para autofiltro, mas se isso facilita, pode por!.. geralmente os dados ficam soltos e sem filtro mesmo, chegando a ter aproximadamente 60 mil linha, ao final do mês. na primeira semana do mês umas 15 mil linhas, para cada atualização semanal.

enquanto eu escrevia aqui, até agora a tabela está travada - rodando o codigo que me passou no já existente;
#61480
osvaldomp escreveu: 13 Jan 2021 às 14:41
teixeire escreveu: 13 Jan 2021 às 13:35 Eu deixei filtrada e exclui muitas linhas para conseguir postar o arquivo aqui, o que estava no link é o original.
Se o arquivo for grande ele precisa ser compactado para anexar aqui.

Testei seu código e aparentemente funcional, chamando pelo código que já estava pronto, porém sem os filtros demora MUITO para rodar.
Sim, no seu exemplo com o Auto Filtro aplicado o código analisa somente 4 células, porém sem o Filtro ele analisa 1780+ células, por isso o tempo é bem maior. Se o seu código atual aplica o Auto Filtro então chame o novo código depois do filtro aplicado, se não, como eu sugeri antes, passe o(s) critério(s) para aplicar o Auto Filtro, assim incluiremos no código que passei os comandos para filtrar.

o que preciso, em si é:
Isso que você descreveu é o que faz o código que passei, com exceção do item 2, que você não comentou antes e que eu incluí no código abaixo, coloque esse no lugar do anterior.
No entanto, o que eu quis dizer na mensagem anterior é que se você não conseguir rodar o código que passei associado ao existente, então nos informe com exatidão o que você quer fazer (ou o que o seu código atual faz) assim poderemos elaborar um novo código a aí já incorporando o que passei.


enquanto eu escrevia aqui, até agora a tabela está travada - rodando o codigo que me passou no já existente;
Não entendi.

1 - Eu deixei desbloqueada para não ter problema nos testes;
É recomendável manter as formatações originais no arquivo anexado.

2 - Como você sugere que seja aplicado só quando as novas linhas forem adicionadas ? pq tem que aperecer dai;
Por tratar- se Tabela Excel então ao iniciar uma nova linha, manualmente ou via macro, o Excel "puxa" automaticamente fórmulas e formatos para a nova linha, não é necessário "esticar" formatos para além da Tabela já prevendo o seu crescimento futuro.
Código: Selecionar todos
Sub BuscaDados()
 Dim Doc As Range
  With Sheets("Data")
   .Protect "Henkel2020", UserInterFaceOnly:=True
   For Each Doc In .Range("AV3:AV" & Cells(Rows.Count, 48).End(3).Row).SpecialCells(xlVisible)
    If Application.CountIf(Sheets("Week Update").[AK:AK], Doc.Value) = 0 Then
     .Cells(Doc.Row, "AT") = "Historical"
    ElseIf .Cells(Doc.Row, "AT") = "Historical" Then
     .Cells(Doc.Row, "AT") = ""
    End If
   Next Doc
  End With
End Sub
esse código de apagar os que já tem historical que contam a info na week update já constava no codigo anterior, não tinha falado... poucos minutos atras lhe enviei o que o codigo faz...

o que pude perceber, é que ao adicionar o seu codigo, algumas linhas que eram para permanecer como estavam, pois constavam nas duas planilhas, foram substituidas com "Historical"...

só pode ser substituido com "Historical", se existe na Data mas não existe mais na Week Update
#61493
Experimente este. Aqui executa em aprox. 15 seg.
O objetivo é executar as operações abaixo:
Ela checa se o valor da coluna AV na aba Data existe na coluna AK da aba Week Update
1 - se não existe o valor na Week UPdate, então substitui o valor da coluna AT aba Data com o valor "Historical", na linha correspondente
2 - Se existe, e o valor atual na coluna AT de Data é Historical, então substitui por vazio
3 - SE existe, e o valor da coluna ATnão é igual a "Historical, então permanece tudo como está;
4 - Se o valor existe só na aba Week Update, então adiciona o intervalo de A - AJ na aba Data;

Código: Selecionar todos
Sub AtualizaDados()
 Dim LRd As Long, LRw As Long
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  LRw = Sheets("Week Update").Cells(Rows.Count, "AK").End(3).Row
  LRd = Sheets("Data").Cells(Rows.Count, "AV").End(3).Row
  With Sheets("Data")
   On Error Resume Next
   .[A2:AW2].AutoFilter
   On Error GoTo 0
   .[AX2:AZ2] = "hdr"
   .Range("AY3:AY" & LRd) = "=COUNTIF('Week Update'!AK$3:AK$" & LRw & ",AV3)"
   .Range("AZ3:AZ" & LRd) = "=AND(AY3>0,AT3=""Historical"")"
   If Application.CountIf(.[AY:AY], 0) > 0 Then
    .Range("A2:AZ" & LRd).AutoFilter 51, "=0"
    .Range("AT3:AT" & LRd).SpecialCells(xlVisible) = "Historical"
   End If
   .[A2:AZ2].AutoFilter
   If Application.CountIf(.[AZ:AZ], "True") > 0 Then
    .Range("A2:AZ" & LRd).AutoFilter 52, "VERDADEIRO" 
    .Range("AT3:AT" & LRd).SpecialCells(xlVisible) = ""
   End If
   .[AX:AZ].Delete
  End With
  With Sheets("Week Update")
   On Error Resume Next
   .[A2:AK2].AutoFilter
   On Error GoTo 0
   .[AL2:AM2] = "hdr"
   .Range("AM3:AM" & LRw) = "=COUNTIF(Data!AV$3:AV$" & LRd & ",AK3)"
   If Application.CountIf(.[AM:AM], 0) > 0 Then
    .Range("A2:AM" & LRw).AutoFilter 39, "=0"
    .Range("A3:AT" & LRw).Copy
    Sheets("Data").Cells(LRd + 1, 1).PasteSpecial xlValues
   End If
   .[AM:AM].Delete
  End With
  Application.Calculation = xlCalculationAutomatic
End Sub
#61561
osvaldomp escreveu:Experimente este. Aqui executa em aprox. 15 seg.
O objetivo é executar as operações abaixo:
Ela checa se o valor da coluna AV na aba Data existe na coluna AK da aba Week Update
1 - se não existe o valor na Week UPdate, então substitui o valor da coluna AT aba Data com o valor "Historical", na linha correspondente
2 - Se existe, e o valor atual na coluna AT de Data é Historical, então substitui por vazio
3 - SE existe, e o valor da coluna ATnão é igual a "Historical, então permanece tudo como está;
4 - Se o valor existe só na aba Week Update, então adiciona o intervalo de A - AJ na aba Data;

Código: Selecionar todos
Sub AtualizaDados()
 Dim LRd As Long, LRw As Long
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  LRw = Sheets("Week Update").Cells(Rows.Count, "AK").End(3).Row
  LRd = Sheets("Data").Cells(Rows.Count, "AV").End(3).Row
  With Sheets("Data")
   On Error Resume Next
   .[A2:AW2].AutoFilter
   On Error GoTo 0
   .[AX2:AZ2] = "hdr"
   .Range("AY3:AY" & LRd) = "=COUNTIF('Week Update'!AK$3:AK$" & LRw & ",AV3)"
   .Range("AZ3:AZ" & LRd) = "=AND(AY3>0,AT3=""Historical"")"
   If Application.CountIf(.[AY:AY], 0) > 0 Then
    .Range("A2:AZ" & LRd).AutoFilter 51, "=0"
    .Range("AT3:AT" & LRd).SpecialCells(xlVisible) = "Historical"
   End If
   .[A2:AZ2].AutoFilter
   If Application.CountIf(.[AZ:AZ], "True") > 0 Then
    .Range("A2:AZ" & LRd).AutoFilter 52, "VERDADEIRO" 
    .Range("AT3:AT" & LRd).SpecialCells(xlVisible) = ""
   End If
   .[AX:AZ].Delete
  End With
  With Sheets("Week Update")
   On Error Resume Next
   .[A2:AK2].AutoFilter
   On Error GoTo 0
   .[AL2:AM2] = "hdr"
   .Range("AM3:AM" & LRw) = "=COUNTIF(Data!AV$3:AV$" & LRd & ",AK3)"
   If Application.CountIf(.[AM:AM], 0) > 0 Then
    .Range("A2:AM" & LRw).AutoFilter 39, "=0"
    .Range("A3:AT" & LRw).Copy
    Sheets("Data").Cells(LRd + 1, 1).PasteSpecial xlValues
   End If
   .[AM:AM].Delete
  End With
  Application.Calculation = xlCalculationAutomatic
End Sub
Oi Osvaldo, tudo bem ?
Me desculpe não aparecer aqui antes para agradecer, pois só tive tempo hoje para fazer o teste;

... e então, testei com a planilha completa de linha (e não a versão postada aqui), e foi executada em 13 minutos e 13 segundos, e o que pude perceber é que o item 4 não foi coberto. :(

o código antigo, demora poucos segundos, e com a adição do que faltava (macro que me enviou), foi executada em 12 minutos e 8 segundos - todos os tópicos cobertos.

me pergunto (não sei consertar o código inicial mesmo), se seria possível consertar o primeiro (eu não manjo), senão ficaria com ele em 12 minutos mesmo, não sei.

Desde já, muito obrigada !
Bom final de semana :)
#61562
teixeire escreveu: 17 Jan 2021 às 12:18 ... o item 4 não foi coberto. :(
Você testou no arquivo que você colocou aqui como exemplo ? Qual foi o resultado ?

... seria possível consertar o primeiro ...
Vou tentar. O item que ele não faz e que você descreveu no seu primeiro post acima corresponde ao item 1 da lista do post #61473 aí acima, é isso ?
dica - para responder clique em + Resposta localizada abaixo da última postagem, só clique em Citação se necessário.
#61573
Opa, achei o +Resposta !


Testei, o resultado deu certo, só o topico 4, que é adicionar as linhas que só existe em Week Update, na aba Data que não deu certo!

... e o tempo foi aquele que comentei (testado na planilha de situação real - pois exclui várias linhas para ser possível anexar aqui)

....
... seria possível consertar o primeiro ...
Vou tentar. O item que ele não faz e que você descreveu no seu primeiro post acima corresponde ao item 1 da lista do post #61473 aí acima, é isso ?

Exato ! ... a única coisa que ele não tá fazendo é colocar o Historical para as linhas que existem em Data, mas não existem mais em WeekUpdate.
#61577
teixeire escreveu: 18 Jan 2021 às 11:50 ... só existe em Week Update, na aba Data que não deu certo!
Hummm ... o Bozo aqui colocou o código errado no post.
Por favor teste esse abaixo no arquivo do seu exemplo aí acima, pois é esse que eu deveria ter postado antes.


Exato ! ... a única coisa que ele não tá fazendo é colocar o Historical para as linhas que existem em Data, mas não existem mais em WeekUpdate.
Ok, vou tentar acertar esse.
Código: Selecionar todos
Sub AtualizaDadosV2()
 Dim LRd As Long, LRw As Long
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  LRw = Sheets("Week Update").Cells(Rows.Count, "AK").End(3).Row
  LRd = Sheets("Data").Cells(Rows.Count, "AV").End(3).Row
  With Sheets("Data")
   On Error Resume Next
   .[A2:AW2].AutoFilter
   On Error GoTo 0
   .[AX2:AZ2] = "hdr"
   .Range("AY3:AY" & LRd) = "=COUNTIF('Week Update'!AK$3:AK$" & LRw & ",AV3)"
   .Range("AZ3:AZ" & LRd) = "=AND(AY3>0,AT3=""Historical"")"
   If Application.CountIf(.[AY:AY], 0) > 0 Then
    .Range("A2:AZ" & LRd).AutoFilter 51, "=0" '****
    .Range("AT3:AT" & LRd).SpecialCells(xlVisible) = "Historical"
   End If
   .[A2:AZ2].AutoFilter
   If Application.CountIf(.[AZ:AZ], "True") > 0 Then
    .Range("A2:AZ" & LRd).AutoFilter 52, "VERDADEIRO"
    .Range("AT3:AT" & LRd).SpecialCells(xlVisible) = ""
   End If
   .[AX:AZ].Delete
  End With
  With Sheets("Week Update")
   On Error Resume Next
   .[A2:AK2].AutoFilter
   On Error GoTo 0
   .[AL2:AM2] = "hdr"
   .Range("AM3:AM" & LRw) = "=COUNTIF(Data!AV$3:AV$" & LRd & ",AK3)"
   If Application.CountIf(.[AM:AM], 0) > 0 Then
    .Range("A2:AM" & LRw).AutoFilter 39, "=0"
    .Range("A3:AJ" & LRw).Copy
    Sheets("Data").Cells(LRd + 1, 1).PasteSpecial xlValues
   End If
   .[AM:AM].Delete
  End With
  Application.Calculation = xlCalculationAutomatic
End Sub
#61600
Oi Osvaldo !

Vixxee, rsrsrsrs !
Eu testei de novo e não funcionou;
Eu estou testando com arquivo que fiz, onde tem exatamente as linhas que sofrem alteração (todos os tópicos citados menos o 3), e faço a conferência; Desta vez a única coisa que mudou comparada com a última versão, foi o tempo de execução, que caiu para 12 minutos !

Perdão desde já por ocupar seu tempo, mas é que não to conseguindo resolver isso mesmo. :(

Adicionei um arquivo de conferência das linhas, pra ficar mais fácil de visualizar.
Você não está autorizado a ver ou baixar esse anexo.
#61640
Faça testes no arquivo anexo.
É cópia do primeiro arquivo que você postou e instalei nele o código que passei por último.
Veja os comentários nas duas planilhas.
Coloquei um botão em cada planilha, para rodar basta clicar em um deles.
As planilhas e a Pasta deixei desprotegidas.
Aqui roda em aprox. 30seg.

October_2020_Updated Guru V4.zip
Você não está autorizado a ver ou baixar esse anexo.

Boa noite. Talvez este tópico seja interes[…]

@AfonsoMira , o meu aconteceu a mesma coisa. E[…]

Boa tarde, conforme o titulo, tem como puxar texto[…]

Boa noite pessoal! Eu tenho uma dúvida, e […]

Boas Obrigado pela resposta Realmente em parte o […]

Boas tudo bem, por agora só consegui resol[…]

Boa tarde! Trabalho em uma empresa e possuimos co[…]

[Ajuda] Vba criar pastas

:roll: Olá a todos estou batendo a cabe&cce[…]