Excel procurar valor por linha, e se não encontrado em outra aba, substituir

[Eloize Teixeira]

 

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"

planilha aqui

 

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