help needed writing a function used in a query 3

[VickyC]

hello to all

I'm hoping to get help completing a query (qryQ) based on table (tblQ).

Here's tblQ...

ID X0 X1 X2 X3 X4 X5 X6
A A B C F G L N
B A B D E H L M
C A C D E I K N
D B C D F H I O
E B C E F J K M
....
N A C H J M N O
O D F K L M N O

ID runs from A to O. The remaining 7 columns are also filled with values A to O. (I'm aware that the table is not normalized, but I don't think it is necessary here. I could change this if needed.)

I need to construct a query (qryQ) having 4 columns. Typical rows look like...
A B C 13
A C D 13
A D E 15
etc...

a) the first 3 columns show ALL combinations (no repeats, order not important) of 3 values of ID. There will be 455 records.

I've done this with SQL like...

SELECT tblQ_0.ID, tblQ_1.ID, tblQ_2.ID
FROM tblQ AS tblQ_0, tblQ AS tblQ_1, tblQ AS tblQ_2
WHERE (
((tblQ_0.ID)<tblQ_1.ID) And
((tblQ_1.ID)<tblQ_2.ID)
)
ORDER BY tblQ_0.ID, tblQ_1.ID, tblQ_2.ID;


b) HERE'S where I'm having a problem. The 4th column involves a function that outputs an integer value...

A B C 13 means that in records tblQ.ID = A, tblQ.ID = B and tblQ.ID = C, columns x0 to x6 involve 13 DISTINCT values (A, B, C, D, E, F, G, H, I, K, L, M and N. There is no J nor O)

A D E 15 means that records A, D and E have all 15 values (A to O) in columns X0 to X6.

So far I've not been able to write code for this function (in either SQL, if possible, or VBA). Any assistance would be appreciated.

Thank you
Vicky

 

[MajP]

Select...... countUnique(tblQ_0.ID, tblQ_1.ID, tblQ_2.ID) as UniqueValues....

change the tblName to the correct query or table.

Public Function CountUnique(ParamArray Xi() As Variant) As Integer
   On Error GoTo errLabel
   Const tblName = "PermuteData"
   Dim X As Variant
   Dim strSql As String
   Dim uniqueX As New Collection
   Dim rs As DAO.Recordset
   Dim fld As DAO.Field
   
   strSql = "SELECT X0, X1, X2, X3, X4, X5, X6 "
   strSql = strSql & "FROM " & tblName
   strSql = strSql & " Where ID = '" & Xi(0) & "' or ID = '" & Xi(1) & "' or ID = '" & Xi(2) & "'"
   Set rs = CurrentDb.OpenRecordset(strSql, dbReadOnly)
   Do While Not rs.EOF
     For Each fld In rs.Fields
       uniqueX.Add fld, fld
     Next fld
     rs.MoveNext
   Loop
   CountUnique = uniqueX.Count
   Exit Function
errLabel:
  If Err.Number = 457 Then
    Resume Next
  Else
    MsgBox Err.Number & " " & Err.Description
  End If
End Function

 

[VickyC]

MajP - works like a charm. Very instructive as well.

Many thanks, Vicky

 

[MajP]

What exactly are you building? You have come up with some challenging questions?

 

[VickyC]

I'm working on some scheduling problems (just for my own interest). In this case, the capital letters represent clusters of events, and the number generated by your formula gives me insights into how to integrate these clusters into a larger structure.

 

[MajP]

Here is a better solution to the same problem. The previous was very clunky with adding things to a collection and throwing an error if it exists already

If you had lots of records the below would also be faster. It is also more traditional "database" oriented.

Public Function CountUnique2(ParamArray Xi() As Variant) As Integer
   On Error GoTo errLabel
   Const tblName = "PermuteData"
   Dim strSql As String
   Dim strWhere As String
   Dim rs As DAO.Recordset
   
   strWhere = " Where ID = '" & Xi(0) & "' or ID = '" & Xi(1) & "' or ID = '" & Xi(2) & "'"
   
   strSql = " SELECT PermuteData.X0 as Xi FROM " & tblName
   strSql = strSql & strWhere
   strSql = strSql & " UNION SELECT PermuteData.X1 FROM " & tblName
   strSql = strSql & strWhere
   strSql = strSql & " UNION SELECT PermuteData.X2 FROM " & tblName
   strSql = strSql & strWhere
   strSql = strSql & " UNION SELECT PermuteData.X3 FROM " & tblName
   strSql = strSql & strWhere
   strSql = strSql & " UNION SELECT PermuteData.X4 FROM " & tblName
   strSql = strSql & strWhere
   strSql = strSql & " UNION SELECT PermuteData.X5 FROM " & tblName
   strSql = strSql & strWhere
   strSql = strSql & " UNION SELECT PermuteData.X6 FROM " & tblName
   strSql = strSql & strWhere
   Debug.Print strSql
   Set rs = CurrentDb.OpenRecordset(strSql, dbReadOnly)
   If Not (rs.EOF And rs.BOF) Then
     rs.MoveLast
     rs.MoveFirst
     CountUnique2 = rs.RecordCount
    End If
   Exit Function
errLabel:
      MsgBox Err.Number & " " & Err.Description
End Function

 

[PHV]

Why a VBA function ?
I'd try this pure SQL solution:

SELECT A.ID, B.ID, C.ID, (SELECT COUNT(*) FROM (
SELECT X0 FROM tblQ WHERE ID IN(A.ID, B.ID, C.ID) UNION
SELECT X1 FROM tblQ WHERE ID IN(A.ID, B.ID, C.ID) UNION
SELECT X2 FROM tblQ WHERE ID IN(A.ID, B.ID, C.ID) UNION
SELECT X3 FROM tblQ WHERE ID IN(A.ID, B.ID, C.ID) UNION
SELECT X4 FROM tblQ WHERE ID IN(A.ID, B.ID, C.ID) UNION
SELECT X5 FROM tblQ WHERE ID IN(A.ID, B.ID, C.ID) UNION
SELECT X6 FROM tblQ WHERE ID IN(A.ID, B.ID, C.ID)
) U) AS myCount
FROM (tblQ A
INNER JOIN tblQ B ON A.ID < B.ID)
INNER JOIN tblQ C ON B.ID < C.ID
ORDER BY A.ID, B.ID, C.ID

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[VickyC]

Thanks to PHV and MajP for some really nice coding.
Vicky

 

[VickyC]

hi PHV - I really like your all-SQL solution, but I can't quite get it to work. When I run the query, parameter windows pop up asking for the value of A.ID, then B.ID, then C.ID. When I remove the 'A.ID' from the line...

SELECT X0 FROM tblQ WHERE ID IN(A.ID, B.ID, C.ID)

... the first parameter window asks for B.ID. So, I'm guessing the problem is in the subquery part of the code. I don't think the subquery is recognizing the alias values.

Is there a quick fix? Vicky