Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 23

Thread: Extract Matching Cell Values in Two Columns and Paste in New Columns

  1. #1
    VBAX Regular
    Joined
    Jan 2019
    Posts
    88
    Location

    Extract Matching Cell Values in Two Columns and Paste in New Columns

    Hi

    New here and seem to have hit a brick wall so back to the board.

    I have tried amending some previous code to give me a different output. Seemed simple enough but I am not getting the desired output and I'm also not sure it's the most efficient method.

    Basically I have two columns and all I am trying to do is copy any matching/duplicate names in both columns to a new column J. Column I is simply numbered 1,2,3, etc and is dynamically generated.

    The number of candidates in both columns can of course change and is not fixed.

    I've attached my file and would appreciate any help. I can do it in Excel but would like a Excel VBA script to do it.

    Many thanks in advance.
    Attached Files Attached Files

  2. #2
    VBAX Regular
    Joined
    Jan 2019
    Posts
    88
    Location
    Anyone?

  3. #3
    Knowledge Base Approver VBAX Guru
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    4,591
    try
    Sub MatchCandidates()
    Application.ScreenUpdating = False
    Dim LastRow As Long, GR1 As Long, aName As Range, bName As Range
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    GR1 = Range("B:B").Find("GROUP 1").Row
    With Range("I4:J" & LastRow)
      .Borders.LineStyle = xlNone
      .ClearContents
    End With
    'Cells(Rows.Count, "B").End(xlUp).Select
    Set BList = Range(Cells(Rows.Count, "B").End(xlUp), "B" & GR1 + 1)
    'BList.Select
    Set FList = Range(Cells(Rows.Count, "F").End(xlUp), "F" & GR1 + 1)
    'FList.Select
        
    Set Destn = Range("J4")    'where the firsdt result will go.
    For Each cll In FList.Cells
      If Not IsError(Application.Match(cll.Value, BList, 0)) Then
        Destn.Value = cll.Value
        Set Destn = Destn.Offset(1)
      End If
    Next cll
        
        
    With Range("I4")
      If .Offset(0, 1) <> "" Then    'check that there is some data to deal with
        .Value = 1
        On Error Resume Next    ' suppress the error message, no series to fill
        .AutoFill Destination:=Range("I4").Resize(Range("J" & Rows.Count).End(xlUp).Row - 3), Type:=xlFillSeries
        On Error GoTo 0    'reinstate error notification
        .Resize(Range("J" & Rows.Count).End(xlUp).Row - 3, 3).Borders.LineStyle = xlContinuous
      End If
    End With
    Application.ScreenUpdating = True
    End Sub
    From your code it looks like you thought that GR1 would be at the bottom of the list but it remained the row on which GROUP 1 was found in column B.
    p45cal - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  4. #4
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    394
    Location
    Hi branston!
    I made a macro with autofilter, which was interesting.
    Column I is not processed, sorry.

    --Okami

    Sub test()
    Dim arr, rng As Range
    arr = Range("f4:f" & [f65536].End(3).Row)
    arr = Application.Transpose(arr)
    Application.ScreenUpdating = False
    [a4].AutoFilter Field:=2, Criteria1:=arr, Operator:=xlFilterValues
    Range("b4:b" & [b65536].End(3).Row).Copy [j4]
    [a4].AutoFilter
    Application.ScreenUpdating = True
    Set rng = Nothing
    End Sub

  5. #5
    VBAX Regular
    Joined
    Jan 2019
    Posts
    88
    Location
    Thanks p45cal - that's a great help.

    If there was some data at the top of the columns and some more data below both columns, would it be possible to fix the range of the array? Of course this list may change but as long as I can fix the array range then it should not be an issue. I only want the data from the fixed array and not all of the data above and below.

    Sorry I should have been clearer in my original post.

    I've attached the file again so you know what I mean.

    Thanks again
    Attached Files Attached Files

  6. #6
    VBAX Regular
    Joined
    Jan 2019
    Posts
    88
    Location
    Thanks Okami that looks very neat.

    I wasn't clear in my original post ... If there was some data at the top of the columns and some more data below both columns, would it be possible to fix the range of the array? Of course this list may change but as long as I can fix the array range then it should not be an issue. I only want the data from the fixed array and not all of the data above and below.

    Also there are no numbers dynamically generated on the new list in column I ???? ie. 1,2,3,etc. however many candidates are matching.

    Thank again
    Last edited by branston; 06-20-2019 at 02:10 AM.

  7. #7
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    394
    Location
    Hi branston!
    No problem if there are empty rows and columns between the upper and lower data sources.
    Sub test()
    Dim arrOri, arrRst, d As Object, i&, r&
    Set d = CreateObject("scripting.dictionary")
    arrOri = [a7].CurrentRegion
    ReDim arrRst(1 To UBound(arrOri), 1 To 2)
    For i = 3 To UBound(arrOri)
      d(arrOri(i, 2)) = ""
    Next i
    arrOri = [e7].CurrentRegion
    For i = 3 To UBound(arrOri)
      If d.exists(arrOri(i, 2)) Then
        r = r + 1
        arrRst(r, 1) = r
        arrRst(r, 2) = arrOri(i, 2)
        d.Remove arrOri(i, 2)
      End If
    Next i
    [i9].Resize(r, 2) = arrRst
    End Sub

  8. #8
    VBAX Regular
    Joined
    Jan 2019
    Posts
    88
    Location
    Thanks Okami - really appreciate it.

    If I try to move my range around the spreadsheet and amend the code slightly for some reason the matching names are not being selected and copied properly. For e.g. if I wanted Group2 candidates matching you can see it is just listing the names in TASKA GROUP2 instead of matching them with TASKB GROUP2 candidates.

    What am I doing wrong?

    File attached.
    Attached Files Attached Files
    Last edited by branston; 06-20-2019 at 04:13 AM.

  9. #9
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    394
    Location
    Hi branston!
    Currtregion can only get the size of a separate area.
    There must be empty rows and columns between data areas.
    In your current example, the data areas are linked together,
    so it needs to be processed.

    Sub test()
    Dim arrOri, arrRst, d As Object, i&, r&
    Set d = CreateObject("scripting.dictionary")
    [i9].CurrentRegion.ClearContents
    'arrOri = [N9].CurrentRegion  'for test
    arrOri = [N72].CurrentRegion
    'arrOri = [N120].CurrentRegion  'for test
    ReDim arrRst(1 To UBound(arrOri), 1 To 2)
    For i = 3 To UBound(arrOri)
      If arrOri(i, 2) = "" Then Exit For
      d(arrOri(i, 2)) = ""
    Next i
    For i = 3 To UBound(arrOri)
      If arrOri(i, 6) = "" Then Exit For
      If d.exists(arrOri(i, 6)) Then
        r = r + 1
        arrRst(r, 1) = r
        arrRst(r, 2) = arrOri(i, 6)
        d.Remove arrOri(i, 6)
      End If
    Next i
    [i9].Resize(r, 2) = arrRst
    End Sub

  10. #10
    Knowledge Base Approver VBAX Guru
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    4,591
    If lists of names are going to be all over the place, and they're not all headed with the same headers or tasks, then it might be easier each time to ask the user where they are and where he wants the results.
    The following will ask the user this and allow him to select them with the mouse:
    Sub MatchCandidates()
    Dim List1 As Range, List2 As Range, Destn As Range
    On Error Resume Next
    Set List1 = Application.InputBox("Select the first list of names", "1st List", , , , , , 8)
    If List1 Is Nothing Then Exit Sub
    Set List2 = Application.InputBox("Select the second list of names", "2nd List", , , , , , 8)
    If List2 Is Nothing Then Exit Sub
    Set Destn = Application.InputBox("Select where you want the results", "Destination", , , , , , 8)    'where the result will go.
    If Destn Is Nothing Then Exit Sub
    On Error GoTo 0
    
    Set List1 = List1.Columns(1)
    Set List2 = List2.Columns(1)
    Set Destn = Destn.Cells(1)
    
    Application.ScreenUpdating = False
    Count = 0    'for numbering the results
    For Each cll In List2.Cells
      If Not IsError(Application.Match(cll.Value, List1, 0)) Then
        Count = Count + 1
        Destn.Value = Count
        Destn.Offset(, 1).Value = cll.Value
        Set Destn = Destn.Offset(1)
      End If
    Next cll
    Application.ScreenUpdating = True
    End Sub
    p45cal - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  11. #11
    VBAX Regular
    Joined
    Jan 2019
    Posts
    88
    Location
    Thanks p45cal .. will give it a shot. Not exactly what I'm after but it may be a better longer term solution for me.

  12. #12
    VBAX Regular
    Joined
    Jan 2019
    Posts
    88
    Location
    Okami - this is great. Thank you for your help. Didn't realise you could do an autofilter like this in a macro - very neat.

    Okami - I am trying to add some more data to my final list. This data comes from the '#' and 'Room' columns. Of course this data does not have to match as only the names need to match.

    Is it possible to copy this data across also (even though it doesn't match). I've tried amending the code but it doesn't work. Also the Title Headings for each column disappear when the final list is created. I need them to stay intact. If the final table could have a border around it that would be great.

    I've attached my list again - could you take a look please?


    Thanks again for all your help.
    Attached Images Attached Images
    Attached Files Attached Files
    Last edited by branston; 06-20-2019 at 12:10 PM.

  13. #13
    VBAX Regular
    Joined
    Jan 2019
    Posts
    88
    Location
    If anybody could help I would appreciate it as it's a bit urgent and I can't seem to get my head around it!

    BTW The above screenshot should read "A-GRP2" (not "A-GRP1")

  14. #14
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    394
    Location
    Hi branston!
    TASK B - GROUP 1 has some duplicate data, and the corresponding # number and room number is different, How to deal with it.
    In addition, will TASK A have the same situation as TASK B?
    Last edited by 大灰狼1976; 06-21-2019 at 05:36 AM.

  15. #15
    VBAX Regular
    Joined
    Jan 2019
    Posts
    88
    Location
    Hi Okami

    I have attached a screen shot of how the data should look. Any data that is with a matching name just needs to be copied across regardless of whether it matches the other group or not. Only the names in each group need to match not any additional data.

    (The final list needs borders around it to make it clear to read)

    Hope this is clear and thanks again.
    Attached Images Attached Images

  16. #16
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    394
    Location
    Sorry, the picture is not clear. Can you explain it in a workbook?
    Everything else is OK. I need to see how duplicate data is processed in the same TASK of the same GROUP.

  17. #17
    VBAX Regular
    Joined
    Jan 2019
    Posts
    88
    Location
    Hi Okami

    No problem. I've attached the file again but I have just copied the additional column data ( in columns I,J,K,L,M ) manually from columns (O,R,V,U,W). Obviosuly I would want this doing automatically via the macro.

    I am concerned about all of the other data around the table and whether this will affect the final list data once processed?

    File attached and thank you.
    Attached Files Attached Files

  18. #18
    VBAX Regular
    Joined
    Jan 2019
    Posts
    88
    Location
    Hi

    Would it possible to do this with a range of cells being copied across into the final destination (as opposed to just one column each)?

    The dilemma I have is that only columns P and T only are being matched for equivalence, but if I wanted the corresponding cells in columns Q and R (for column P) and cells in columns U,V,W (for column T) also being copied .. how would I do that because I am not bothered if cells in columns Q and R and columns U,V,W match or not?
    Attached Files Attached Files

  19. #19
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    394
    Location
    Hi branston!
    The processing method is very simple. I just don't understand how to deal with the duplicate data.
    Please simulate a result of the blue area of the attachment.
    Attached Files Attached Files

  20. #20
    VBAX Regular
    Joined
    Jan 2019
    Posts
    88
    Location
    Hi Okami

    Very sorry not sure how that has happened, there should not be duplicate names in column T. Must have been a copying error.

    I've removed the duplicates and attached the file again. Is it clear now?
    Attached Files Attached Files

Posting Permissions

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