Matching data between two sheets and cutting and pasting

[tomleitch]

I'm looking for some help/pointers with some vba (which I'm not great with).

What I'm trying to do is this....


Column A on worksheet 1 contains "Item Number"

Column A on worksheet 2 also contains "Item Number"


I want to find matching ones in worksheet 2 and cut and paste the data from worksheet 2 that row column E to the matching row column E on worksheet 1... if that makes sense. With the same match I also want to cut column G on worksheet 2 to column F on worksheet 1.

Any help much appreciated.

Thanks,
Tom

 

[Fluff]

The code in post#12 & the updated code in post#19, will only write data to cols E & F if the values are different.
If you are dealing with dates are they just dates or date & time?
Also are they both real dates, or is one text that looks like a date?

 

[tomleitch]

Hi Fluff, they are dates with time on them as well, so maybe that is something to do with the problem?

... if possible I'd like them to only show the date when they are pasted if this is possible?

Thanks
Tom

 

[Fluff]

Try this mod

      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Array(Format(Cl.Offset(, 4).Value, "dd/mm/yyyy"), Cl.Offset(, 6).Value)
      Next Cl

 

[tomleitch]

Can't get this bit to work..... but I forgot to say - only one of the columns has a date/time in it... the other has just text in it Column on sheet 2 G, going to 1 F is date and time. Column sheet 2 E to sheet 1 E is text.

Cheers
Tom

 

[Fluff]

In that case

         If Not .exists(Cl.Value) Then .Add Cl.Value, Array(Cl.Offset(, 4).Value, Format(Cl.Offset(, 6).Value, "dd/mm/yyyy"))

 

[tomleitch]

Hi Fluff.... maybe I'm doing something wrong, but I can't get it to work - I'm getting an error saying 'Object Required'

from what you told me, I've got this code

   Dim Cl As Range
   Dim Ky As Variant
   Dim NxtRw As Long
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   
   Set Ws1 = Sheets("OPS PLANNER")
   Set Ws2 = Sheets("UPDATE TOOL")
   
   With CreateObject("scripting.dictionary")
         For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
          If Not .exists(Cl.Value) Then .Add Cl.Value, Array(Cl.Offset(, 4).Value, Format(Cl.Offset(, 6).Value, "dd/mm/yyyy"))
      Next Cl
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then
           Union(.Item(Cl.Value).Offset(, 4), .Item(Cl.Value).Offset(, 6)).Copy Cl.Offset(, 4)
           .Remove (Cl.Value)
         End If
      Next Cl
      NxtRw = Ws1.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      For Each Ky In .keys
         Ws1.Range("A" & NxtRw).Value = Ky
         Union(.Item(Ky).Offset(, 4), .Item(Ky).Offset(, 6)).Copy Ws1.Range("E" & NxtRw)
         NxtRw = NxtRw + 1
      Next Ky
   End With
End Sub

 

[Fluff]

You should be running the code I supplied in post#19 along with the mod in post#25

 

[tomleitch]

Got it, thanks. Really appreciate your help.

 

[Fluff]

Glad to help & thanks for the feedback

 

[tomleitch]

Hi Fluff. Just noticed that my dates column (Column F on sheet 1) is showing changes to dates that aren't being updated on most of the dates when I run my macro. Not sure if this is something to do with removing the time?

Sub CopyDataUnique()
   Dim Cl As Range
   Dim Ky As Variant
   Dim NxtRw As Long
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   
   Set Ws1 = Sheets("OPS PLANNER")
   Set Ws2 = Sheets("UPDATE TOOL")
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
                  If Not .exists(Cl.Value) Then .Add Cl.Value, Array(Cl.Offset(, 4).Value, Format(Cl.Offset(, 6).Value, "dd/mm/yyyy"))
      Next Cl
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then
            If Trim(UCase(Cl.Offset(, 4).Value)) <> Trim(UCase(.Item(Cl.Value)(0))) Then Cl.Offset(, 4).Value = .Item(Cl.Value)(0)
            If Trim(UCase(Cl.Offset(, 5).Value)) <> Trim(UCase(.Item(Cl.Value)(1))) Then Cl.Offset(, 5).Value = .Item(Cl.Value)(1)
           .Remove (Cl.Value)
         End If
      Next Cl
      NxtRw = Ws1.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      For Each Ky In .keys
         Ws1.Range("A" & NxtRw).Value = Ky
         Ws1.Range("E" & NxtRw).Resize(, 2).Value = .Item(Ky)
         NxtRw = NxtRw + 1
      Next Ky
   End With
End Sub