Macro to compare 2 arrays based on multiple conditions

M

mtode

New member
Joined
Mar 21, 2014
Messages
3
Reaction score
0
Points
0
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>
 

Attachments

  • Sample_case.xlsx
    8.7 KB · Views: 15
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:
patel said:
this code works on attached sample (position only one char)
Click to expand...

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.


 

Attachments

  • Sample_case2.xlsm
    19.1 KB · Views: 16
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:
patel said:
try this code
Click to expand...

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>
 
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
 
You must log in or register to reply here.
Back
Top