COMBINATORY ANALYSIS UP TO 32 NUMBERS WITHOUT OVERFLOWS THE LINES LIMITS EXCEL

[Paulo Silveira Xpto]

HELLO, I HAVE A VBA CODE THAT WORKS WITH UP TO 32 NUMBERS UNDER COMBINATORY ANALYSIS. IT FILLS AN EXCEL COLUMN WITH 906,192 LINES. IF I CHOOSE MORE THAN 32 NUMBER THERE IS AN ERROR, BECAUSE THE EXCEL LIMIT OF LINES OVERFLOWS. I NEED HELP CREATING NEW COLUMNS, SOMETHING LIKE THIS, I REACHED LINE 1,000,000 NEW COLUMNS ARE CREATED AND THE SEQUENCE CONTINUES.

THE CODE IS BELOW

Option Explicit

Private aResult As ListObject 'Tabela de resultados
Private aValor As ListObject  'Tabela de valores a combinar
Private aListRowIndex As Long 'Linha da tabela de resultados
Private aNumElements As Long  'Quantidade de valores a combinar disponíveis
Private aNumCols As Long      'Quantidade de elementos em cada grupo de combinação
Private aNumRows As Long      'Quantidade de resultados gerados

Private Sub Main()
    Dim Elements As Variant 'Elementos disponíveis para combinar
    Dim Result As Variant   'Set de resultados de cada iteração
   
    'Inicialização de variáveis
    Set aResult = Me.ListObjects("loResult")
    Set aValor = Me.ListObjects("loValor")
    Elements = WorksheetFunction.Transpose(aValor.DataBodyRange)
    aNumElements = UBound(Elements)
    aNumCols = Me.Range("TamanhoGrupo")
    'Validação
    If aNumCols > aNumElements Then
        MsgBox "A quantidade de repetições deve ser menor ou igual à quantidade de valores disponíveis.", vbInformation
        GoTo Quit
    End If
    aNumRows = WorksheetFunction.Combin(aNumElements, aNumCols)
    ReDim Result(1 To aNumCols)
    aListRowIndex = 1
   
    'Formatar tabela de resultados
    FormatTable
   
    'Inicia a recursão para gerar as combinações
    Combinar Elements, aNumCols, Result, 1, 1
Quit:
End Sub
 
Sub Combinar(ByVal Elements As Variant, _
             ByVal p As Long, _
             ByVal Result As Variant, _
             ByVal iElement As Integer, _
             ByVal iIndex As Integer)
    Static iEvents As Long 'Para desafogar temporariamente processos pendentes do Excel
    Dim i As Long
   
    iEvents = iEvents + 1
    If iEvents Mod 100 = 0 Then DoEvents
    
    For i = iElement To aNumElements
        Result(iIndex) = Elements(i)
        If iIndex = p Then
            aResult.ListColumns(1).DataBodyRange(aListRowIndex).Resize(, p) = Result
            aListRowIndex = aListRowIndex + 1
        Else
            Combinar Elements, p, Result, i + 1, iIndex + 1
            'Se quiser que seja calculado um Arranjo ao invés da Combinação,
            'comente a expressão acima e use a expressão abaixo:
            'Combinar Elements, p, Result, i, iIndex + 1
        End If
    Next i
End Sub

Private Sub FormatTable()
    Dim iCol As Long
   
    With aResult
        If .ListColumns.Count > 1 Then
            .ListColumns(2).Range.Resize(, .ListColumns.Count - 1).Delete
        End If
        If .ListRows.Count > 0 Then .DataBodyRange.ClearContents
   
        .Resize .Range.Resize(1 + aNumRows, aNumCols)
       
        For iCol = 1 To .ListColumns.Count
            .HeaderRowRange(iCol) = "Col" & iCol
        Next iCol
    End With
End Sub

 

[shknbk2]

This substitutes using the loResult table with simply referencing the cell reference. I'm not sure if the loResult table will expand as entries are put in underneath it, but the FormatTable code could be changed to incorporate the data as part of the table.

When the row > 1,000,000, the row restarts at 3 and the column jumps to the right by 4.

Option Explicit

Private aResult As ListObject 'Tabela de resultados
Private aValor As ListObject  'Tabela de valores a combinar
Private aListRowIndex As Long 'Linha da tabela de resultados
Private aListColIndex As Long
Private aNumElements As Long  'Quantidade de valores a combinar disponíveis
Private aNumCols As Long      'Quantidade de elementos em cada grupo de combinação
Private aNumRows As Long      'Quantidade de resultados gerados

Private Sub Main()
    Dim Elements As Variant 'Elementos disponíveis para combinar
    Dim Result As Variant   'Set de resultados de cada iteração
   
    'Inicialização de variáveis
    Set aResult = Me.ListObjects("loResult")
    Set aValor = Me.ListObjects("loValor")
    Elements = WorksheetFunction.Transpose(aValor.DataBodyRange)
    aNumElements = UBound(Elements)
    aNumCols = Me.Range("TamanhoGrupo")
    'Validação
    If aNumCols > aNumElements Then
        MsgBox "A quantidade de repetições deve ser menor ou igual à quantidade de valores disponíveis.", vbInformation
        GoTo Quit
    End If
    aNumRows = WorksheetFunction.Combin(aNumElements, aNumCols)
    ReDim Result(1 To aNumCols)
    aListRowIndex = 3
    aListColIndex = 8
   
    'Formatar tabela de resultados
    FormatTable
   
    'Inicia a recursão para gerar as combinações
    Combinar Elements, aNumCols, Result, 1, 1
Quit:
End Sub
 
Sub Combinar(ByVal Elements As Variant, _
             ByVal p As Long, _
             ByVal Result As Variant, _
             ByVal iElement As Integer, _
             ByVal iIndex As Integer)
    Static iEvents As Long 'Para desafogar temporariamente processos pendentes do Excel
    Dim i As Long
   
    iEvents = iEvents + 1
    If iEvents Mod 100 = 0 Then DoEvents
    
    For i = iElement To aNumElements
        Result(iIndex) = Elements(i)
        If iIndex = p Then
            Cells(aListRowIndex, aListColIndex).Resize(, p) = Result
            aListRowIndex = aListRowIndex + 1
            If aListColIndex > 1000000 Then
                aListColIndex = aListColIndex + 4
                aListRowIndex = 3
            End If
        Else
            Combinar Elements, p, Result, i + 1, iIndex + 1
            'Se quiser que seja calculado um Arranjo ao invés da Combinação,
            'comente a expressão acima e use a expressão abaixo:
            'Combinar Elements, p, Result, i, iIndex + 1
        End If
    Next i
End Sub

Private Sub FormatTable()
    Dim iCol As Long
   
    With aResult
        If .ListColumns.Count > 1 Then
            .ListColumns(2).Range.Resize(, .ListColumns.Count - 1).Delete
        End If
        If .ListRows.Count > 0 Then .DataBodyRange.ClearContents
   
        .Resize .Range.Resize(1 + aNumRows, aNumCols)
       
        For iCol = 1 To .ListColumns.Count
            .HeaderRowRange(iCol) = "Col" & iCol
        Next iCol
    End With
End Sub

 

[Paulo Silveira Xpto]

UNFORTUNATELY, THE ERROR CONTINUES, WHEN THE NUMBER OF 32 IS EXCEEDED, THAT IS, THE LIMIT OF ROWS PER COLUMN IS OVERFLOW AND THE MESSAGE APPEARS Execution time error 1004
Application definition or object definition error AND WHEN CLICKING THE RUN BUTTON, THE ERROR 400 ARISES. MAYBE YOUR TABLE SUGGESTION WORKS, BUT WHEN THE CODE ARRIVES ON THE LINE .Resize .Range.Resize(1 + aNumRows, anNumCols) ARISES THE MISTAKE. I TRIED TO SEND THE MINI SHEET PART AND I CAN'T.

 

[Fluff]

@Paulo Silveira Xpto In future please do not post in capitals like that, it is considered shouting & therefore rude. Thanks

 

[Paulo Silveira Xpto]

I'm so sorry I didn't mean it won't happen again

 

[Paulo Silveira Xpto]

Maybe if there was no memory space reservation in the loResult variable like ListObject and we could work with the one that counts the number of rows, aNumRows, in such a way that the limit of rows per column does not overflow, hence the part of formatting the table would work and maybe new columns would appear. So I don't know how to do it. Sorry for the bad English. I'm trying via google translate.

 

[Paulo Silveira Xpto]

If there was a way to set the loResult variable as a ListObject of a matrix with n rows and n columns, something like, 10 groups of 7 columns, by way of example in the case of 6 numbers per row, so that there is a column of white space separating the groups.

 

[Paulo Silveira Xpto]

Hello, I came up with a new idea that might suddenly help. Since the problem is Excel limit lines overflow, then would it be possible to direct all number sequence output to a .txt file? Hence it would not be necessary to reserve those memory arrays in Excel. As I said up to 32 numbers taken 6 X 6 the code works perfect. From 33 onwards, it gives an error. Perhaps the output via .txt is the solution!

 

[shknbk2]

Your first post wasn't clear on how many columns you were looking for in the group size. Knowing that you are looking for 6 columns, I changed the code. It should now work with any group size, but my first code only assumed the size was 3.

I tested numbers 1-33 in the Values table with a group size of 6. The loResult fills up to row 1,000,000 and then a separate group starts at row 3 seven columns to the right to finish the list. It successfully produced the 1,107,568 combinations for 33 nCr 6.

Only the first part of the results are in the loResults table. The overflow data is produced to the right, but it is not in a table object. If all of the data needs to be in a table, then there would have to be additional formatting to make the tables to the right.

Option Explicit

Private aResult As ListObject 'Tabela de resultados
Private aValor As ListObject  'Tabela de valores a combinar
Private aListRowIndex As Long 'Linha da tabela de resultados
Private aListColIndex As Long
Private aNumElements As Long  'Quantidade de valores a combinar disponíveis
Private aNumCols As Long      'Quantidade de elementos em cada grupo de combinação
Private aNumRows As Long      'Quantidade de resultados gerados
Private aNumSubRows As Long
Private iEvents As Long

Private Sub Main()
    Dim Elements As Variant 'Elementos disponíveis para combinar
    Dim Result As Variant   'Set de resultados de cada iteração
  
    'Inicialização de variáveis
    Set aResult = ActiveSheet.ListObjects("loResult")
    Set aValor = ActiveSheet.ListObjects("loValor")
    Elements = WorksheetFunction.Transpose(aValor.DataBodyRange)
    aNumElements = UBound(Elements)
    aNumCols = Range("TamanhoGrupo")
    iEvents = 0
    'Validação
    If aNumCols > aNumElements Then
        MsgBox "A quantidade de repetições deve ser menor ou igual à quantidade de valores disponíveis.", vbInformation
        GoTo Quit
    End If
    aNumRows = WorksheetFunction.Combin(aNumElements, aNumCols)
    ReDim Result(1 To aNumCols)
    aListRowIndex = 3
    aListColIndex = 8
  
    'Formatar tabela de resultados
    FormatTable
  
    'Inicia a recursão para gerar as combinações
    Combinar Elements, aNumCols, Result, 1, 1
    Application.StatusBar = False
Quit:
End Sub
 
Sub Combinar(ByVal Elements As Variant, _
             ByVal p As Long, _
             ByVal Result As Variant, _
             ByVal iElement As Integer, _
             ByVal iIndex As Integer)
   
    Dim i As Long
   
    For i = iElement To aNumElements
        Result(iIndex) = Elements(i)
        If iIndex = p Then
            iEvents = iEvents + 1
            If iEvents Mod 100 = 0 Then DoEvents
            If iEvents Mod 50 = 0 Then Application.StatusBar = "Current combination: " & iEvents
            If aListRowIndex > 1000000 Then
                aListColIndex = aListColIndex + aNumCols + 1
                aListRowIndex = 3
            End If
            Cells(aListRowIndex, aListColIndex).Resize(, p) = Result
            aListRowIndex = aListRowIndex + 1
        Else
            Combinar Elements, p, Result, i + 1, iIndex + 1
            'Se quiser que seja calculado um Arranjo ao invés da Combinação,
            'comente a expressão acima e use a expressão abaixo:
            'Combinar Elements, p, Result, i, iIndex + 1
        End If
    Next i
End Sub

Private Sub FormatTable()
    Dim iCol As Long
  
    With aResult
        If .ListColumns.Count > 1 Then
            .ListColumns(2).Range.Resize(, .ListColumns.Count - 1).Delete
        End If
        Range(Cells(1, .ListColumns(1).Range.Column + 1), Cells(Rows.Count, Columns.Count)).ClearContents
        If .ListRows.Count > 0 Then .DataBodyRange.ClearContents
       
        aNumSubRows = aNumRows
        If aNumRows > 1000000 Then
            aNumSubRows = 1000000
            aNumRows = aNumRows - 1000000
        End If
       
        .Resize .Range.Resize(1 + aNumSubRows, aNumCols)
      
        For iCol = 1 To .ListColumns.Count
            .HeaderRowRange(iCol) = "Col" & iCol
        Next iCol
    End With
End Sub

 

[Paulo Silveira Xpto]

Exactly. It worked with 6 columns and over a million rows. The question of the table I'm going to break my head with it. 99.99% perfect. Thank you so much. It helped immensely. No words to thank.