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]

Hi Fluff,

I wonder if you could kindly help me again with this.... I have changed where one of my data fields copies from column F to coliumn G.

I worked out how to change it in the case that column A value does not exist - however in the instance that it does exist then it is writing value from ws1 to ws2 into column F.

I'm sure it's an easy fix, but I'm not quite sure how! what I have is this...

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(, 1).Value, Cl.Offset(, 4).Value, Cl.Offset(, 5).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(, 1).Value = "" Then Cl.Offset(, 1).Value = .Item(Cl.Value)(0)
            If Trim(UCase(Cl.Offset(, 4).Value)) <> Trim(UCase(.Item(Cl.Value)(1))) Then Cl.Offset(, 4).Value = .Item(Cl.Value)(1)
            If Trim(UCase(Cl.Offset(, 3).Value)) <> Trim(UCase(.Item(Cl.Value)(2))) Then Cl.Offset(, 3).Value = .Item(Cl.Value)(2)
            If CLng(Cl.Offset(, 5).Value) <> CLng(.Item(Cl.Value)(3)) Then Cl.Offset(, 5).Value = .Item(Cl.Value)(3)
           .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("B" & NxtRw).Value = .Item(Ky)(0)
         Ws1.Range("E" & NxtRw).Value = .Item(Ky)(1)
         Ws1.Range("D" & NxtRw).Value = .Item(Ky)(2)
         Ws1.Range("G" & NxtRw).Value = .Item(Ky)(3)
         NxtRw = NxtRw + 1
      Next Ky

 

[tomleitch]

Think I've worked it out now...

   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(, 1).Value, Cl.Offset(, 4).Value, Cl.Offset(, 5).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(, 1).Value = "" Then Cl.Offset(, 1).Value = .Item(Cl.Value)(0)
            If Trim(UCase(Cl.Offset(, 4).Value)) <> Trim(UCase(.Item(Cl.Value)(1))) Then Cl.Offset(, 4).Value = .Item(Cl.Value)(1)
            If Trim(UCase(Cl.Offset(, 3).Value)) <> Trim(UCase(.Item(Cl.Value)(2))) Then Cl.Offset(, 3).Value = .Item(Cl.Value)(2)
            If CLng(Cl.Offset(, 6).Value) <> CLng(.Item(Cl.Value)(3)) Then Cl.Offset(, 6).Value = .Item(Cl.Value)(3)
           .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("B" & NxtRw).Value = .Item(Ky)(0)
         Ws1.Range("E" & NxtRw).Value = .Item(Ky)(1)
         Ws1.Range("D" & NxtRw).Value = .Item(Ky)(2)
         Ws1.Range("G" & NxtRw).Value = .Item(Ky)(3)
         NxtRw = NxtRw + 1
      Next Ky
   End With

Thanks T

 

[tomleitch]

Hi,

I now have a sheet (Ws3) that I am using to archive old items...

What I would like to do is when it looks up the column A numbers in Ws2 for it to first look in Ws3 and see if they are there....and if they are then do nothing for that item and row.


Thanks
Tom

 

[Fluff]

Try adding this

      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(, 1).Value, cl.Offset(, 4).Value, cl.Offset(, 5).Value, cl.Offset(, 6).Value)
      Next cl
      [COLOR=#0000ff]For Each cl In Ws3.Range("A2", Ws3.Range("A" & Rows.Count).End(xlUp))
         If .exists(cl.Value) Then .Remove (cl.Value)
      Next cl[/COLOR]
      For Each cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))

 

[tomleitch]

Many thanks Fluff, once again (as usual) that has done the business!

Much appreciated.

 

[Fluff]

You're welcome

 

[tomleitch]

Fluff, any chance you could be kind enough in coming to the rescue again??

I'm using this code, although I've amended it a bit and one of the things that I want to do is to get it to add a comment in to a cell

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(, 1).Value, Cl.Offset(, 2).Value, Cl.Offset(, 3).Value, Cl.Offset(, 4).Value, Cl.Offset(, 5).Value, Cl.Offset(, 6).Value, Cl.Offset(, 7).Value, Cl.Offset(, 8).Value)
      
               
                
            
            
      Next Cl
    '''''
    ' Remove cl if existing in archived
    


       For Each Cl In Ws3.Range("A2", Ws3.Range("A" & Rows.Count).End(xlUp))
       If .exists(Cl.Value) Then .Remove (Cl.Value)
       
       
       Next Cl
       


       
      '*********************
     
      For Each Cl In Ws1.Range("A10", Ws1.Range("A" & Rows.Count).End(xlUp))
     
            If .exists(Cl.Value) Then
            
            'Check/update Desc and add location as comment
            If Trim(UCase(Cl.Offset(, 1).Value)) <> Trim(UCase(.Item(Cl.Value)(0))) Then
            Cl.Offset(, 1).Value = .Item(Cl.Value)(0)
            On Error Resume Next
            Cl.Offset(, 1).ClearComments
            On Error GoTo 90
            Cl.Offset(, 1).AddComment
            Cl.Offset(, 1).Comment.Text = .Item(Cl.Value)(6)
            Cl.Offset(, 1).Interior.Color = rgbYellow
            End If

So that's a part of the code and the bit I'm having trouble with is the bit where I'm trying to add comment text.

Can you shed any light?

Cl.Offset(, 1).Comment.Text = .Item(Cl.Value)(6)

is the bit that seems to be wrong.


Thanks
Tom

 

[Fluff]

As this is a totally different question, you will need to start a new thread.
Thanks

 

[tomleitch]

As this is a totally different question, you will need to start a new thread.
Thanks

Will do - cheers