Number Combination

[sotiris]

I have a Table (Table01)in Access with one number field name Num (double)
I want a routine to create a new table example Table02 with 2 fields the first
with combinations of the numbers of Table01 and the 2nd field with the sum of the combinations

Example:

Table01
NUM
1
2
3

Table02
Field01 Field02
1 1
2 2
3 3
1,2 3
1,3 4
2,3 5
1,2,3 6

Thanks,
Sotiris

I have find a code in VB but how can I use it in Access mdb file.

1. Dim Table2() As String
2. Dim TmpDou As Double
3. Dim i() As Integer 'hoping you table has less than 32000 elements
4. Dim j As Integer
5. Dim n As Integer
6. Dim k As Long 'this will be for counting the combinations
7. Dim Boo1 As Boolean
8. TmpDou = UBound(Table1) - LBound(Table1) + 1 'The number of elements in table1
9. TmpDou = 2 ^ TmpDou - 1 'the number of combinations excluding the empty one
10. ReDim Table2(1 To TmpDou, 1 To 2) 'this will be our working space
11. ReDim i(1 To TmpDou) 'this will be for counting
12. 'In case your indexes doesnt start at cero:
13.
14. n = 1
15. Do
16. If n > UBound(Table1) - LBound(Table1) + 1 Then Exit Do
17. ReDim i(1 To n)
18. For j = 0 To n - 1
19. i(j + 1) = LBound(Table1) + j
20. Next
21. Do
22. k = k + 1
23. TmpDou = 0
24. For j = 1 To n
25. Table2(k, 1) = Table2(k, 1) & Table1(i(j)) & ", "
26. TmpDou = TmpDou + Table1(i(j))
27. Next
28. Table2(k, 1) = Left(Table2(k, 1), Len(Table2(k, 1)) - 2)
29. Table2(k, 2) = TmpDou
30. i = i + 1
31. If i > UBound(Table1) Then
32. j = n - 1
33. i = UBound(Table1)
34. Do
35. If j = 0 Then
36. Boo1 = True
37. Exit Do
38. End If
39. If i(j) < i(j + 1) - 1 Then
40. i(j) = i(j) + 1
41. i(j + 1) = i(j) + 1
42. Exit Do
43. Else
44. j = j - 1
45. End If
46. Loop
47. End If
48. If Boo1 = True Then
49. n = n + 1
50. Boo1 = False
51. Exit Do
52. End If
53.
54. Loop
55. Loop

 

[WayneRyan]

Sotiris,

I have no idea what you use this for, but here goes ...

I added an initial chunk of code to read the data into your Table1 array.
I added a trailing chunk of code to write the data into Table2.
It doesn't CREATE Table2, but it will fill it out.

Dim Table2() As String
Dim TmpDou As Double
Dim i() As Integer 'hoping you table has less than 32000 elements
Dim j As Integer
Dim n As Integer
Dim k As Long 'this will be for counting the combinations
Dim Boo1 As Boolean
'
' Fill the array Table1 with the contents of the table Table1
'
Dim Table1(1) As Double
Dim rst As DAO.Recordset
Dim i As Long

Set rst = CurrentDb.OpenRecordset("Select * From Table1")
rst.MoveLast
ReDim Table1(1 To rst.RecordCount)
rst.MoveFirst
For i = 1 To rst.RecordCount
   Table1(i) = rst!Num
   Next i
rst.Close
Set rst = Nothing
'
' End-Of-Initial chunk
'
TmpDou = UBound(Table1) - LBound(Table1) + 1 'The number of elements in table1
TmpDou = 2 ^ TmpDou - 1 'the number of combinations excluding the empty one

ReDim Table2(1 To TmpDou, 1 To 2) 'this will be our working space
ReDim i(1 To TmpDou) 'this will be for counting
 
'In case your indexes doesnt start at zero:
 
 n = 1
 Do
    If n > UBound(Table1) - LBound(Table1) + 1 Then Exit Do
    ReDim i(1 To n)
    For j = 0 To n - 1
       i(j + 1) = LBound(Table1) + j
       Next
    Do
       k = k + 1
       TmpDou = 0
       For j = 1 To n
          Table2(k, 1) = Table2(k, 1) & Table1(i(j)) & ", "
          TmpDou = TmpDou + Table1(i(j))
          Next
       Table2(k, 1) = Left(Table2(k, 1), Len(Table2(k, 1)) - 2)
       Table2(k, 2) = TmpDou
       i(n) = i(n) + 1
       If i(n) > UBound(Table1) Then
          j = n - 1
          i(n) = UBound(Table1)
          Do
             If j = 0 Then
                Boo1 = True
                Exit Do
             End If
             If i(j) < i(j + 1) - 1 Then
                i(j) = i(j) + 1
                i(j + 1) = i(j) + 1
                Exit Do
             Else
                j = j - 1
             End If
             Loop
      End If
      If Boo1 = True Then
         n = n + 1
         Boo1 = False
         Exit Do
      End If
   Loop
Loop
'
' Now write out table2
'
Set rst = CurrentDb.OpenRecordset("Select * From Table2")
For i = 1 to UBound(Table2)
   rst.Addnew
   rst!Field01 = Table2(i, 1)
   rst!Field02 = Table2(i, 2)
   rst.Update
   Next i
rst.Close
Set rst = Nothing

hth,
Wayne

 

[WayneRyan]

Sotiris,

Also, you can just paste the code into the OnClick event of a Command Button.

Wayne

 

[sotiris]

Thanks for the reply, WayneRyan.

When I run the code firstly a get an error in line
Dim i as Long [Duplicate declaration in current scope]

Also when bypass the line with 'Dim i as Long
I get an error in the line
ReDim Table1(1 To rst.RecordCount) [Array already dimensioned]

Have you any idea about the errors
Thanks,
Sotiris

 

[WayneRyan]

Sotiris,

How many rows do you have in Table1?

If you can give me a sample of Table1, I'll make up a sample DB for you
later today.

Wayne

 

[WayneRyan]

SotIris,

OK, now I see what you're doing.

See attached.

Wayne

 

[sotiris]

Thanks for the reply, WayneRyan.