Results 1 to 6 of 6

Thread: Macro to compare 2 arrays based on multiple conditions

  1. #1

    Macro to compare 2 arrays based on multiple conditions



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hello,

    Please kindly help me with a solution for the following issue:

    I have 2 lists, each of them having 2 columns.
    First is a catalog of Positions (column A - Name of Position; column B - list of conditions for each position) and second is a list of Candidates with their competences (column A: Candidate name; Column B: assigned competences)

    I need to compare the two lists and to create a new list in a new worksheet containing the name of Candidate and the assigned Position (position is assigned if the candidate has all the needed competences)

    I've attached a sample file which better demonstrate what exactly I need.
    The real scenario contains aprox. 2100 lines for candidates list and 500 lines for positions catalog

    Thank you very much.
    I really appreciate your help,
    <mtode>
    Attached Files Attached Files

  2. #2
    Acolyte patel's Avatar
    Join Date
    Feb 2014
    Location
    Italy
    Posts
    59
    Articles
    0
    this code works on attached sample (position only one char)
    Code:
    Sub a()
    LRA = Cells(Rows.Count, "A").End(xlUp).Row
    LRE = Cells(Rows.Count, "E").End(xlUp).Row
    drow = 3
    Range("A3:B" & LRA).Sort key1:=Range("a3"), order1:=xlAscending, key2:=Range("B3"), order2:=xlAscending, Header:=xlNo, DataOption1:=xlSortTextAsNumbers
    
    s1 = Cells(3, 1) & "_" & Cells(3, 2)
    For r = 4 To LRA
      If Cells(r, 1) = Cells(r - 1, 1) Then
        s1 = s1 & Cells(r, 2)
      Else
        s1 = s1 & Cells(r, 1) & "_" & Cells(r, 2)
      End If
    Next
    Range("E3:F" & LRE).Sort key1:=Range("E3"), order1:=xlAscending, key2:=Range("F3"), order2:=xlAscending, Header:=xlNo, DataOption1:=xlSortTextAsNumbers
    s2 = Cells(3, "E") & "_" & Cells(3, "F")
    For r = 4 To LRA
      If Cells(r, "E") = Cells(r - 1, "E") Then
        s2 = s2 & Cells(r, "F")
      Else
    '    Stop
        cand = Left(s2, InStr(s2, "_") - 1)
        cond = Right(s2, Len(s2) - InStr(s2, "_"))
        Cells(drow, "I") = cand
        p = InStr(s1, cond)
        If p > 0 Then
          Cells(drow, "J") = Mid(s1, p - 2, 1)
        Else
          Cells(drow, "J") = "N/A"
        End If
        
        drow = drow + 1
        s2 = Cells(r, "E") & "_" & Cells(r, "F")
      End If
    Next
    End Sub
    Last edited by patel; 2014-03-22 at 08:54 AM.

  3. #3
    Quote Originally Posted by patel View Post
    this code works on attached sample (position only one char)
    Dear Patel,

    Thank you so much for your help. I made some minor changes in your code to process all the Candidates from the list.
    Unfortunately I have an issue if the Candidate has multiple "Matched Conditions" than those assigned to a position (see LLL where C1 si an "extra" condition for Position "F"). In this case your program logic is not working.

    See attached example version 2.


    Attached Files Attached Files

  4. #4
    Acolyte patel's Avatar
    Join Date
    Feb 2014
    Location
    Italy
    Posts
    59
    Articles
    0
    try this code
    Code:
    Sub Proc()
    LRA = Cells(Rows.Count, "A").End(xlUp).Row
    LRE = Cells(Rows.Count, "E").End(xlUp).Row
    drow = 3
    Range("E3:F" & LRE).Sort key1:=Range("E3"), order1:=xlAscending, key2:=Range("F3"), order2:=xlAscending, Header:=xlNo, DataOption1:=xlSortTextAsNumbers
    s1 = Join(Application.Transpose(Range("F3:F" & LRE)), "#")
    Range("A3:B" & LRA).Sort key1:=Range("a3"), order1:=xlAscending, key2:=Range("B3"), order2:=xlAscending, Header:=xlNo, DataOption1:=xlSortTextAsNumbers
    pos = Cells(3, "A")
    s2 = Cells(3, "B")
    For r = 4 To LRA + 1 'otherwise last candidate is not inserted in final list
      If Cells(r, "A") = Cells(r - 1, "A") Then
        s2 = s2 & "#" & Cells(r, "B")
      Else
        p = InStr(s1, s2)
        If p > 0 Then
          r1 = UBound(Split(Left(s1, p), "#")) + 3
          Cells(drow, "I") = Cells(r1, "E")
          Cells(drow, "J") = pos
          drow = drow + 1
        End If
        pos = Cells(r, "A")
        s2 = Cells(r, "B")
      End If
    Next
    MsgBox ("Done!!!")
    End Sub
    Last edited by patel; 2014-03-24 at 04:14 PM.

  5. #5
    Quote Originally Posted by patel View Post
    try this code
    Hi Patel,

    Nice try:-) It is working but it fails when the same position is "matched" by multiple candidates. In my example the last candidate LLL is not transferred to the final list (LLL should have the same assignment as CCC - position "F").


    Many thanks,
    <mtode>

  6. #6
    Acolyte patel's Avatar
    Join Date
    Feb 2014
    Location
    Italy
    Posts
    59
    Articles
    0
    Code:
    Sub Proc()
    LRA = Cells(Rows.Count, "A").End(xlUp).Row
    LRE = Cells(Rows.Count, "E").End(xlUp).Row
    drow = 3
    Range("E3:F" & LRE).Sort key1:=Range("E3"), order1:=xlAscending, key2:=Range("F3"), order2:=xlAscending, Header:=xlNo, DataOption1:=xlSortTextAsNumbers
    s1 = Join(Application.Transpose(Range("F3:F" & LRE)), "#")
    Range("A3:B" & LRA).Sort key1:=Range("a3"), order1:=xlAscending, key2:=Range("B3"), order2:=xlAscending, Header:=xlNo, DataOption1:=xlSortTextAsNumbers
    pos = Cells(3, "A")
    s2 = Cells(3, "B")
    For r = 4 To LRA + 1
      If Cells(r, "A") = Cells(r - 1, "A") Then
        s2 = s2 & "#" & Cells(r, "B")
      Else
        i = 1
        Do
          p = InStr(i, s1, s2)
          If p > 0 Then
            r1 = UBound(Split(Left(s1, p), "#")) + 3
            Cells(drow, "I") = Cells(r1, "E")
            Cells(drow, "J") = pos
            drow = drow + 1
          Else
            Exit Do
          End If
          i = p + 1
        Loop
          pos = Cells(r, "A")
          s2 = Cells(r, "B")
      End If
    Next
    MsgBox ("Done!!!")
    End Sub

Posting Permissions

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