Grouping from several comparisons

[piflechien73]

Hello,

I would like to identify groups that are totally independants.

In this example, there would be 2 groups:

-Albert, Alex and Claude that have one-to-one features in common: the eyes ( green) and/or hair (black) and/or nose(long) IN GROUP 1
-Audrey and Claire that have blonde hair IN GROUP 2

FIRST_NAME_09-->CODE_09------------->GROUP

ALBERT--> EYES_GREEN------------>1
ALBERT--> HAIR_BLACK------------>1
ALEX----> NOSE_LONG------------>1
ALEX----> EYES_GREEN------------>1
ALEX----> HAIR_BLACK------------>1
AUDREY-> HAIR_BLONDE------------>2
CLAIRE--> HAIR_BLONDE------------>2
CLAUDE-> NOSE_LONG------------>1
CLAUDE-> HAIR_BLACK------------>1

Important:

I am looking for a general solution to this problem, that can manage thousands of features.
To make it easier, there would never interferences between 2 groups : for example one person from group 2 will never have green eyes or long nose.

Is it possible to create through SQL/function a query that automatically compares and create groups?
Find here database

Thanks in advance for help!

 

[khawar]

Creat a seperate table for features and assign groups to them

 

[piflechien73]

Hello,

Finally I was helped by a friend who fixed it through a module.

In case some are interested, find it below ;-)

-------------------------------------------------

Option Compare Database
Const TableName = "BLOUB"
Const Code = "CODE"
Const Name = "PRENOM"
Const GRP = "GRP"


'Instruction: Please change the column names above before your run the program.


Sub Test()


Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim RecordNumber As Integer

Dim CodeRecord As String
Dim NameRecord As String
Dim SQL As String
Dim GroupRecord As Variant
Dim WinningGroup As Variant

Set db = CurrentDb()
Set rs1 = db.OpenRecordset(TableName, dbOpenDynaset)




DoCmd.SetWarnings False

'SQL = "UPDATE Grouping_function SET Grouping_function.GRP = Null;"
SQL = "UPDATE " & TableName & " SET " & TableName & ".GRP = Null;"
DoCmd.RunSQL (SQL)

rs1.MoveFirst
Do Until rs1.EOF


CodeRecord = rs1.Fields.Item(Code)
NameRecord = rs1.Fields.Item(Name)

RecordNumber = rs1.AbsolutePosition


GroupRecord = FindInRecordset(CodeRecord, NameRecord)

If IsNull(GroupRecord) Then
rs1.Edit
rs1.Fields.Item("GRP") = RecordNumber
rs1.Update

Else
rs1.Edit
rs1.Fields.Item("GRP") = GroupRecord
rs1.Update
End If


rs1.MoveNext

Loop

rs1.MoveFirst
Do Until rs1.EOF
CodeRecord = rs1.Fields.Item(Code)
GroupRecord = rs1.Fields.Item(GRP)

WinningGroup = ReviewGroup(CodeRecord, GroupRecord)

rs1.MoveNext

Loop

DoCmd.SetWarnings True

End Sub

Function FindInRecordset(CodeRecord As String, NameRecord As String)
Dim db As DAO.Database
Dim rs2 As DAO.Recordset

Set db = CurrentDb()
Set rs2 = db.OpenRecordset(TableName, dbOpenDynaset)

rs2.MoveFirst
Do Until rs2.EOF

If NameRecord = rs2.Fields.Item(Name) Then
Group = rs2.Fields.Item(GRP)
FindInRecordset = Group
Exit Function

End If

If CodeRecord = rs2.Fields.Item(Code) And NameRecord <> rs2.Fields.Item(Name) Then
GroupRecord = rs2.Fields.Item(GRP)
FindInRecordset = GroupRecord

Exit Function
End If

rs2.MoveNext
Loop

End Function

Function ReviewGroup(CodeRecord As String, GroupRecord As Variant)
Dim db As DAO.Database
Dim rs3 As DAO.Recordset

Set db = CurrentDb()
Set rs3 = db.OpenRecordset(TableName, dbOpenDynaset)

rs3.MoveFirst

Do Until rs3.EOF
If CodeRecord = rs3.Fields.Item(Code) Then
If GroupRecord < rs3.Fields.Item(GRP) Then
rs3.Edit
rs3.Fields.Item(GRP) = GroupRecord
rs3.Update
ReviewGroup = GroupRecord
Else
GroupRecord = rs3.Fields.Item(GRP)
End If
End If


rs3.MoveNext
Loop

End Function