CODEWITHSUNDEEP
excelcombinations
SCA123
SCA123

Reputation: 1

Excel: Create all Possible Combinations of Column A and (individually) an unlimited number of Columns B thru "x"

I have data in Column A and need the results of all combinations with each of the data in Columns B, C, D, etc...

So I don't need the combinations of all the columns against each other, I need AB, AC, AD, AE, etc...

Easier for my purposes to have the results combined per cell with a space between the now combined data

So for example

Blue   One
Red    Two
Yellow Three

Would become 

Blue One
Blue Two
etc

Like to be able to designate the ordering as well of the combinations, for example, all possibilites for each of Columns B, C, D, etc... where the Column A cell data is appended instead of proceeding

Upvotes: 0

Views: 286

Answers (1)

Scott Craner
Scott Craner

Reputation: 152660

This uses array as much as possible thus limiting the number of time the worksheet is accessed

Sub mygrouping()
    With Worksheets("Sheet6") ' change to your sheet
        Dim rngA As Variant
        rngA = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Value

        Dim rngOthers As Variant
        ReDim rngOthers(1 To Application.CountA(.Range("B1", .Cells(1040000, .Cells(1, .Columns.Count).End(xlToLeft).Column)))) As Variant
        Dim j As Long, k As Long, i As Long
        k = 1
        For j = 2 To .Cells(1, .Columns.Count).End(xlToLeft).Column
            rngintm = .Range(.Cells(1, j), .Cells(.Rows.Count, j).End(xlUp)).Value
            For i = 1 To UBound(rngintm, 1)
                If rngintm(i, 1) <> "" Then
                    rngOthers(k) = rngintm(i, 1)
                    k = k + 1
                End If
            Next i
        Next j
        Dim outarr() As Variant
        ReDim outarr(1 To UBound(rngA, 1) * UBound(rngOthers), 1 To 1)
        k = 1
        For i = 1 To UBound(rngA, 1)
            For j = 1 To UBound(rngOthers)
                outarr(k, 1) = rngA(i, 1) & rngOthers(j)
                k = k + 1
            Next j
        Next i


        'Outputs to another sheet change to your sheet name and desired location
        Worksheets("Sheet7").Range("A1").Resize(UBound(outarr, 1), 1).Value = outarr

    End With
End Sub

Upvotes: 1

Related Questions