Select unique matches among multiple possibilities

galadriel3562 · Apr 17th 2012

I've asked a very similar question here before but now I need something slightly different. The document below shows in the first column of the sheet an identifier of each individual next column shows the number of individuals that match the individual in the first column. Then there's a highlighted column which I would like to fill and behind that are the identifiers of the individuals that match to the individual in the first column.

Basically I had two groups of people and for every person in group 1 I've selected which individuals of group 2 most closely match that person. So, hard work done you'd think. Not so much however, because as you can see, there are multiple matches for some individuals (max = 50 matches). There's no hierarchy to these matches, any is as good as the next, but what I can't have is duplicate matches.

So, I sorted on number of matches and start at the individual with the smallest number of matches. That match is already filled out in the shaded column for the first and second row. For every subsequent row I want to check whether the first match has already been selected as a match to another individual, if that is the case I want to skip that match and move on colomn over to the next, check that one and if it has not yet occurred as a match select that one.

To use an example: row 6 which has individual nr 613. He/She has 4 matching individuals (identifiers: 122, 127, 137 and 335). Now the first match for nr. 613 would be the individual with nr. 122, however that individual was already selected to match a previous individual (in row 2). So I want to skip that individual and skip to the next, thereby matching individual 613 to individual 127 and so on, and so forth.

I'd got pretty far using a number of nested IF statements but ran over the allotted amount of arguments doing it that way. So now I'm looking for a VBA solution - in case I want to change my matching criteria and wind up with a whole new sheet of possible matches.

Could someone help me out?

forum.ozgrid.com/index.php?attachment/45262/

jindon · Apr 17th 2012

Re: Select unique matches among multiple possibilities

Not sure if this is what you want

Code

Sub test()
Dim a, i As Long, ii As Long
a = Sheets(1).Range("a1").CurrentRegion.Value
With CreateObject("System.Collections.ArrayList")
    For i = 2 To UBound(a, 1)
        For ii = 4 To UBound(a, 2)
            If a(i, ii) = Empty Then Exit For
            If Not .contains(a(i, ii)) Then
                .Add a(i, ii)
            Else
                a(i, ii) = Empty
            End If
        Next
    Next
End With
With Sheets(2).Cells(1).Resize(UBound(a, 1), UBound(a, 2))
    .Value = a
    On Error Resume Next
    Cells(1, 4).Resize(, UBound(a, 2)).EntireColumn _
    .SpecialCells(4).Delete xlShiftToLeft
    On Error GoTo 0
End With
End Sub

Display More

galadriel3562 · Apr 17th 2012

Re: Select unique matches among multiple possibilities

Thank you so much for taking the time to look at my problem. But when I put the code you've suggested into macro and run it, it basically doesn't seem to add any matches? It doesn't give any errors, and I'm not a real expert at VBA but shouldn't there be a line of code somewhere copying over the selected match? If so, where would such a line of code be most appropriate?

Thank you again for your time and effort.

jindon · Apr 17th 2012

Re: Select unique matches among multiple possibilities

Quote from galadriel3562

To use an example: row 6 which has individual nr 613. He/She has 4 matching individuals (identifiers: 122, 127, 137 and 335). Now the first match for nr. 613 would be the individual with nr. 122, however that individual was already selected to match a previous individual (in row 2). So I want to skip that individual and skip to the next, thereby matching individual 613 to individual 127 and so on, and so forth.

I've just used this part.
If the code doesn't match your requirement, wait for someone else to help you.

galadriel3562 · Apr 17th 2012

Re: Select unique matches among multiple possibilities

Quote from jindon;604880

I've just used this part.

Ah, that explains it, thank you.

galadriel3562 · Apr 17th 2012

Re: Select unique matches among multiple possibilities

I've tried to get a start on things myself in the mean time and I've got as far as this, though this doesn't work as I want it to, for one it runs on too long and for another it doesn't seem to pick up that it needs to expand the range with the additional match as it appears below the last occupied cell in column C. Added also is an updated version of the worksheet I'm using.

Code

Sub MatchOne()


Dim patient As Integer, r As Range, check As Integer


Sheets("sheet 1").Range("c2:d98").ClearContents


Sheets("sheet 1").Range("c2") = Sheets("sheet 1").Range("e2") ' puts in first value


patient = 1


Do While patient <= 97


Set r = Sheets("sheet 1").Range("c2").End(xlDown) 'selects range to compare next value to, should update with each new match added to columnC 


check = 1


Do While Sheets("sheet 1").Range("d2").Offset(0, patient - 1).Value = 0 Or check <= 50 'do until a match is found or until there are no more cases to compare to


result = Sheets("sheet 1").Range("e3").Offset(check - 1, patient - 1).Value 'select case to compare


If result <> r Then


Sheets("sheet 1").Range("c3").Offset(check - 1, patient - 1).Value = Sheets("sheet 1").Range("e3").Offset(check - 1, patient - 1).Value 'put in additional match
Sheets("sheet 1").Range("d3").Offset(check - 1, patient - 1).Value = 1 'signify that a match was found and stop the inner loop
   
Else


Sheets("sheet 1").Range("d3").Offset(check - 1, patient - 1).Value = 0 'signify that no match was found for this value and go to next case (next colomn over)


End If


check = check + 1


Loop


patient = patient + 1


Loop


End Sub

Display More

forum.ozgrid.com/index.php?attachment/45266/

galadriel3562 · Apr 18th 2012

Re: Select unique matches among multiple possibilities

So

I've sort of solved it, thought I'd share, because I've done it with a lot of typing and regular formulas, so if anyone has an idea on how to get it done using VBA I'd still very much like to know, at the very least it's a great deal easier to read through and adapt, because the formula comes out to about 40 nested IF statements.

=IF(ISNA((MATCH(D3;$C$2:$C2;0)))=TRUE;D3;IF(ISNA((MATCH(E3;$C$2:$C2;0)))=TRUE;E3;IF(ISNA((MATCH(F3;$C$2:$C2;0)))=TRUE;F3;IF(ISNA((MATCH(G3;$C$2:$C2;0)))=TRUE;G3;IF(ISNA((MATCH(H3;$C$2:$C2;0)))=TRUE;H3;IF(ISNA((MATCH(I3;$C$2:$C2;0)))=TRUE;I3;IF(ISNA((MATCH(J3;$C$2:$C2;0)))=TRUE;J3;IF(ISNA((MATCH(K3;$C$2:$C2;0)))=TRUE;K3;IF(ISNA((MATCH(L3;$C$2:$C2;0)))=TRUE;L3;IF(ISNA((MATCH(M3;$C$2:$C2;0)))=TRUE;M3;IF(ISNA((MATCH(N3;$C$2:$C2;0)))=TRUE;N3;IF(ISNA((MATCH(O3;$C$2:$C2;0)))=TRUE;O3;IF(ISNA((MATCH(P3;$C$2:$C2;0)))=TRUE;P3;IF(ISNA((MATCH(Q3;$C$2:$C2;0)))=TRUE;Q3;IF(ISNA((MATCH(R3;$C$2:$C2;0)))=TRUE;R3;IF(ISNA((MATCH(S3;$C$2:$C2;0)))=TRUE;S3;IF(ISNA((MATCH(T3;$C$2:$C2;0)))=TRUE;T3;IF(ISNA((MATCH(U3;$C$2:$C2;0)))=TRUE;U3;IF(ISNA((MATCH(V3;$C$2:$C2;0)))=TRUE;V3;IF(ISNA((MATCH(W3;$C$2:$C2;0)))=TRUE;W3;IF(ISNA((MATCH(X3;$C$2:$C2;0)))=TRUE;X3;IF(ISNA((MATCH(Y3;$C$2:$C2;0)))=TRUE;Y3;IF(ISNA((MATCH(Z3;$C$2:$C2;0)))=TRUE;Z3;IF(ISNA((MATCH(AA3;$C$2:$C2;0)))=TRUE;AA3;IF(ISNA((MATCH(AB3;$C$2:$C2;0)))=TRUE;AB3;IF(ISNA((MATCH(AC3;$C$2:$C2;0)))=TRUE;AC3;IF(ISNA((MATCH(AD3;$C$2:$C2;0)))=TRUE;AD3;IF(ISNA((MATCH(AE3;$C$2:$C2;0)))=TRUE;AE3;IF(ISNA((MATCH(AF3;$C$2:$C2;0)))=TRUE;AF3;IF(ISNA((MATCH(AG3;$C$2:$C2;0)))=TRUE;AG3;IF(ISNA((MATCH(AH3;$C$2:$C2;0)))=TRUE;AH3;IF(ISNA((MATCH(AI3;$C$2:$C2;0)))=TRUE;AI3;IF(ISNA((MATCH(AJ3;$C$2:$C2;0)))=TRUE;AJ3;IF(ISNA((MATCH(AK3;$C$2:$C2;0)))=TRUE;AK3;IF(ISNA((MATCH(AL3;$C$2:$C2;0)))=TRUE;AL3;IF(ISNA((MATCH(AM3;$C$2:$C2;0)))=TRUE;AM3;IF(ISNA((MATCH(AN3;$C$2:$C2;0)))=TRUE;AN3;IF(ISNA((MATCH(AO3;$C$2:$C2;0)))=TRUE;AO3;IF(ISNA((MATCH(AP3;$C$2:$C2;0)))=TRUE;AP3;IF(ISNA((MATCH(AQ3;$C$2:$C2;0)))=TRUE;AQ3;"no match"))))))))))))))))))))))))))))))))))))))))

Above formula would go into column C on the first file I've attached to this thread and then drag down to the bottom

dangle · Apr 26th 2012

Re: Select unique matches among multiple possibilities

Not sure if you are still looking for a VBA solution but this might help:

Code

Sub MatchPatients()
Dim a, i As Long, ii As Long, x As Long
a = Sheets("Sheet1").Range("A1").CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(a, 1)
        For ii = 4 To UBound(a, 2)
            If a(i, ii) <> "" Then
                If Not .exists(a(i, ii)) Then
                    x = x + 1
                    .Item(a(i, ii)) = x
                    a(i, 3) = a(i, ii)
                    Exit For
                End If
            End If
        Next
    Next
End With
Sheets("Sheet2").Range("A1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub

Display More

jindon · Apr 27th 2012

Re: Select unique matches among multiple possibilities

A very similar code to mine is fooling around these days....even the variable names...

Why don't you change the variable names at least?

Select unique matches among multiple possibilities

Participate now!

Share