Combinatorics from excel to accdb, help needed

[didijaba]

HEllo,
I need some good advice, this is beyond my knowledge. I have 16000+ rows with x number of strings in each row (there is one string per cell).
What I need is to make all possible combinations of this strings (per row), joining 2 or 3 in combination. Between strings has to be space.
So if I have A, B, C I would have "A B", "A C", "B C", "B A", "C A", "C B", and all combos with "A B C".

Problem is I have too many combinations, over 1 million so I wanted to fill accdb.
Database name is db_ANTE_VARIATIONS, and table name is tbl_VARIATIONS. Table has three fields, ID_KORISNIK (Autonumber), BROJ_KORISNIKA (short string), IME_PREZIME (short string).

This is what I have so far, pls help.

Sub automateAccessADO_2()

Dim x As String
Dim y As String
Dim cell As Range
Dim strMyPath As String, strDBName As String, strDB As String
Dim strSQL As String

'instantiate an ADO object using Dim with the New keyword:
Dim adoRecSet As New ADODB.Recordset
Dim connDB As New ADODB.Connection


strDBName = "db_ANTE_VARIATIONS.accdb"
strMyPath = ThisWorkbook.Path
strDB = strMyPath & "\" & strDBName

connDB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDB

Dim MyTimer As Double

MyTimer = Timer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim rRng As Range

Dim lRow As Long
Dim j As Long, k As Long, z As Long
For Each cell In Range("W2:W16384")


lRow = 0
Set rRng = Range(cell, cell.Offset(0, cell.Offset(0, -1))) ' The set of values

    For j = 1 To rRng.Count
        For k = 1 To rRng.Count
            For z = 1 To rRng.Count
            
            If WorksheetFunction.And(j <> k, j <> z, k <> z) = True Then
            
                lRow = lRow + 1
                
                x = Trim(Cells(cell.Row, 19))
                y = Trim(Cells(cell.Row, 22 + j) & " " & Cells(cell.Row, 22 + k) & " " & Cells(cell.Row, 22 + z))


connDB.Execute "INSERT INTO tbl_VARIATIONS (BROJ_KORISNIKA, IME_PREZIME) VALUES (x, y)"

connDB.Execute CommandText:=strSQL
            End If
           
            Next z
        Next k
    Next j

Next cell

connDB.Close

Set adoRecSet = Nothing
Set connDB = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox Timer - MyTimer
End Sub

 

[didijaba]

This works.

Sub automateAccessADO_2()

Dim x As String
Dim y As String
Dim y1 As String
Dim y2 As String

Dim cell As Range
Dim strMyPath As String, strDBName As String, strDB As String
Dim strSQL As String
Dim strSQL1 As String
Dim strSQL2 As String

'instantiate an ADO object using Dim with the New keyword:
Dim adoRecSet As New ADODB.Recordset
Dim connDB As New ADODB.Connection


strDBName = "db_ANTE_PIVCE.accdb"
strMyPath = ThisWorkbook.Path
strDB = strMyPath & "\" & strDBName

connDB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDB

Dim MyTimer As Double

MyTimer = Timer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim rRng As Range

Dim lRow As Long
Dim j As Long, k As Long, z As Long
For Each cell In Range("W2:W16384")  '16384


lRow = 0
Set rRng = Range(cell, cell.Offset(0, cell.Offset(0, -1))) ' The set of values

    For j = 1 To rRng.Count
        For k = 1 To rRng.Count
            For z = 1 To rRng.Count
            
            If WorksheetFunction.And(j <> k, j <> z, k <> z) = True Then
            
                lRow = lRow + 1
                
                x = Trim(Cells(cell.Row, 19))
                y = Trim(Cells(cell.Row, 22 + j) & " " & Cells(cell.Row, 22 + k) & " " & Cells(cell.Row, 22 + z))
                y1 = Trim(Cells(cell.Row, 22 + j) & " " & Cells(cell.Row, 22 + k) & "-" & Cells(cell.Row, 22 + z))
                y2 = Trim(Cells(cell.Row, 22 + j) & "-" & Cells(cell.Row, 22 + k) & " " & Cells(cell.Row, 22 + z))


strSQL = "INSERT INTO tbl_VARIATIONS (BROJ_KORISNIKA, IME_PREZIME) VALUES (""" & x & """,""" & y & """)"
strSQL1 = "INSERT INTO tbl_VARIATIONS (BROJ_KORISNIKA, IME_PREZIME) VALUES (""" & x & """,""" & y1 & """)"
strSQL2 = "INSERT INTO tbl_VARIATIONS (BROJ_KORISNIKA, IME_PREZIME) VALUES (""" & x & """,""" & y2 & """)"
'MsgBox strSQL

connDB.Execute CommandText:=strSQL
connDB.Execute CommandText:=strSQL1
connDB.Execute CommandText:=strSQL2
            End If
           
            Next z
        Next k
    Next j

Next cell

connDB.Close

Set adoRecSet = Nothing
Set connDB = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox Timer - MyTimer
End Sub