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]

Yes it is, by removing the time the 2 values are different & hence will get highlighted.

 

[tomleitch]

Thought that could be it. Cool... I'll try and work out a way around it. Thanks

 

[tomleitch]

Fluff, I just noticed that it also seems to be mixing the dates up.

Any date after the 12th of a month seems to get transferred ok - but dates 12 and below it is swapping the day and month round (maybe to an american date?).

Do you know if there is anything I can do to get round this?


Thanks
Tom

 

[Fluff]

Will col G of Update Tool & col F of OPS Planner always have a value, or could some of them be blank?

 

[tomleitch]

Most will contain values, but some will be blank.

 

[Fluff]

I was hopping you wouldn't say that

 

[Fluff]

Try

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("New")
   Set Ws2 = Sheets("Master")
   
   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, Cl.Offset(, 6).Value)
      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 CLng(Cl.Offset(, 5).Value) <> CLng(.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

 

[tomleitch]

Hmm... it seems to work... but after running it the first time I'm getting a Type Mismatch error. Although it does seem to update all the values

 

[Fluff]

Which line gives the error?

 

[tomleitch]

It doesn't highlight anything so I'm not sure.