Results 1 to 6 of 6

Thread: Copy cells if value in other cell matches with cell in another sheet

  1. #1
    New Member
    Join Date
    Sep 2019
    Posts
    15
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Copy cells if value in other cell matches with cell in another sheet

    Hi there,

    I need a macro that does the following:
    In Sheet 2 column E there are ID numbers. The macro should look for those IDs in Sheet 1, column E.
    When found it should copy values in the row of the ID from sheet 1 to sheet 2.
    The values are in column C and D in sheet 1 and are supposed to be copied to columns B and C respectively.
    Any help is very much appreciated.

    Thank you and best regards
    Kristina

  2. #2
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    29,125
    Post Thanks / Like
    Mentioned
    483 Post(s)
    Tagged
    49 Thread(s)

    Default Re: Copy cells if value in other cell matches with cell in another sheet

    How about
    Code:
    Sub Kristina96()
       Dim Cl As Range
       Dim Ws1 As Worksheet, Ws2 As Worksheet
       
       Set Ws1 = Sheets("Sheet1")
       Set Ws2 = Sheets("sheet2")
       With CreateObject("scripting.dictionary")
          For Each Cl In Ws1.Range("E2", Ws1.Range("E" & Rows.Count).End(xlUp))
             .Item(Cl.Value) = Cl.Offset(, -2).Resize(, 2).Value
          Next Cl
          For Each Cl In Ws2.Range("E2", Ws2.Range("E" & Rows.Count).End(xlUp))
             If .exists(Cl.Value) Then Cl.Offset(, -3).Resize(, 2).Value = .Item(Cl.Value)
          Next Cl
       End With
    End Sub
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  3. #3
    New Member
    Join Date
    Sep 2019
    Posts
    15
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copy cells if value in other cell matches with cell in another sheet

    Thank you for the reply. The code is only copying the heading of the column though. Not the values.
    I don't know if it is important but the ID numbers on sheet 1 start in B3 and the IDs in sheet 2 start in E5.

  4. #4
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    29,125
    Post Thanks / Like
    Mentioned
    483 Post(s)
    Tagged
    49 Thread(s)

    Default Re: Copy cells if value in other cell matches with cell in another sheet

    In you op you said they were both in col E. do you still want to copy cols C:D to cols B:C?
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  5. #5
    New Member
    Join Date
    Sep 2019
    Posts
    15
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copy cells if value in other cell matches with cell in another sheet

    Sorry, I had a typo in the OP.
    So, I am trying to look at the values in column B of sheet 1. If column E of sheet 2 already contains that value, no action is required. If not, the value from column B, sheet 1 has to be copoied to column E of sheet 2. Additionally to copying the value itself. The text in colum C and D on sheet 1 should also be copied to column B and C on sheet 2.
    Thank you very much and sorry for the confusion!

  6. #6
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    29,125
    Post Thanks / Like
    Mentioned
    483 Post(s)
    Tagged
    49 Thread(s)

    Default Re: Copy cells if value in other cell matches with cell in another sheet

    Ok, how about
    Code:
    Sub Kristina96()
       Dim Cl As Range
       Dim Ws1 As Worksheet, Ws2 As Worksheet
       
       Set Ws1 = Sheets("sheet1")
       Set Ws2 = Sheets("sheet2")
       With CreateObject("scripting.dictionary")
          For Each Cl In Ws1.Range("B2", Ws1.Range("B" & Rows.Count).End(xlUp))
             .Item(Cl.Value) = Cl.Offset(, 1).Resize(, 2).Value
          Next Cl
          For Each Cl In Ws2.Range("E2", Ws2.Range("E" & Rows.Count).End(xlUp))
             If .Exists(Cl.Value) Then .Remove Cl.Value
          Next Cl
          Ws2.Range("E" & Rows.Count).End(xlUp).Offset(1, -3).Resize(.Count, 2).Value = Application.Index(.Items, 0, 0)
          Ws2.Range("E" & Rows.Count).End(xlUp).Offset(1).Resize(.Count).Value = Application.Transpose(.Keys)
       End With
    End Sub
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •