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

 

[tomleitch]

That also works great, thankyou.


I think this might not be possible to do..... but in theory, would if be possible for when it is first matching the column A (where there is one existing in the sheet 1 already) for it to only paste values if they are different to the value that is already in the destination cell?

The reason being is that as this is auto updating from another imported sheet- I have already got some code that colour fills cells when they are changed to show what has been changed.

At the moment it's changing them regardless of whether they have the same data or not.

If it's really hard to do then I will just scrap the cell colouring idea altogether.


Cheers
Tom

 

[Fluff]

How about

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("Sheet2")
   Set Ws2 = Sheets("data")
   
   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 Cl.Offset(, 4).Value <> .Item(Cl.Value)(0) Then Cl.Offset(, 4).Value = .Item(Cl.Value)(0)
            If Cl.Offset(, 5).Value <> .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]

Hi Fluff.

Unfortunately this doesn't quite work...hence my other post trying to work round it a different way.

The two codes I have are your one (above) and this one:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A5:F2000")) Is Nothing Then Target.Interior.Color = rgbBeige
End Sub

The idea is that it highlights any cells that either have their values changed (e.g. a change of date) or are added as new items.


Regards,
Tom

 

[Fluff]

In what way is it not working?

 

[tomleitch]

In what way is it not working?

Apologies, I don't think I've explained very well.

What I am trying to do is on the time when it matches existing id numbers in column A, I wanted it to only paste the two other columns if the destination cells had a different value - so that they get highlighted if their values have been changed.

Does that make sense?

 

[Fluff]

That's exactly what the code in post#12 should do.
If it's not, then can you explain what it's doing wrong.

 

[tomleitch]

Yeah, I think maybe I'm not explaining it very well.... sorry!

I'm using that code - and it's looking up and matching the column A - but the other two columns (where data is getting pasted in to update if it is different) are being highlighted as changed (by the other code) even when the values stay the same

 

[Fluff]

Check that your values are exactly the same.
if you have leading/trailing spaces or the case different, the values will get changed.

 

[Fluff]

This should deal with case difference & leading/trailing spaces

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 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

 

[tomleitch]

Yeah I've tried running it from the same destination data so I know they are the same.... I think I am explaining badly.

When it looks up column A it has data to copy from the match of column A on sheet 2. Then it copies that row column E and pastes to sheet 1 that row col E - but only if the value in col E on the destination sheet (1) is different to the value that it has copied... like an updated date