Create combinations in Excel VBA

Question

I've scoured the entire website trying to look for a macro (or function) that will create unique combinations from a given list in adjacent columns.

So basically, I have:

A  1  F1  R1  
B  2  F2  
C     F3  
D  
E

And I'm trying to list all the information as (in the same worksheet and in different columns):

A 1 F1 R1  
A 1 F2 R1  
A 1 F3 R1  
A 2 F1 R1  
A 2 F2 R1  
A 2 F3 R1  
B 1 F1 R1  
B 1 F2 R1  
B 1 F3 R1  
B 2 F1 R1  
B 2 F2 R1  
B 2 F3 R1  
...etc.

(added bonus for being able to toggle where the list is printed on the sheet)

It is not clear what you mean by "unique combination" since your examples do not seem to show this working correctly as you are missing lots of values and are mixing items between rows. — enderland
– enderland, Commented May 29, 2013 at 17:20
What exactly do you have? Have you included the cell names in this list? — Bathsheba
– Bathsheba, Commented May 29, 2013 at 17:20
Are there always exactly 4 items in a set? Can the set have repetitions? In other words is A-A-F1-F1 a valid member? Is A-B-C a valid member? You need to be more specific about what constitutes a valid set. — Tyler Durden
– Tyler Durden, Commented May 29, 2013 at 17:25
sorry, i don't know why the formatting messed up when i posted. I meant A, B, C, D, E are all in Column A. 1, 2 is in Column B. F1-3 is in Column C. and R1 is in Column D. I'm trying to create as many combinations as i can from the data. Also, the set cannot have values from the same column, it must use values from different columns and have exactly four items in the set @TylerDurden — user2425910
– user2425910, Commented May 29, 2013 at 17:25

shg · Accepted Answer · 2015-10-28 14:26:13Z

2

There's a workbook at https://app.box.com/s/47b28f19d794b25511be with both formula- and VBA-based methods to do that.

answered Oct 28, 2015 at 14:26

shg

3332 silver badges7 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

shg Over a year ago

I didn't realize this is a two-year old post, sorry.

user2140173 · Accepted Answer · 2013-05-29 18:23:21Z

1

The code to get all possible combinations as follows

Option Explicit

Sub Combinations()

    Dim ws As Worksheet
    Set ws = Sheets("Sheet1")
    Dim a As Range, b As Range, c As Range, d As Range
    Dim x&, y&, z&, w&

    For x = 1 To ws.Range("A" & Rows.Count).End(xlUp).Row
        Set a = ws.Range("A" & x)
        For y = 1 To ws.Range("B" & Rows.Count).End(xlUp).Row
            Set b = ws.Range("B" & y)
            For z = 1 To ws.Range("C" & Rows.Count).End(xlUp).Row
                Set c = Range("C" & z)
                For w = 1 To ws.Range("D" & Rows.Count).End(xlUp).Row
                    Set d = ws.Range("D" & w)
                    Debug.Print a & vbTab & b & vbTab & c & vbTab & d
                    Set d = Nothing
                Next
                Set c = Nothing
            Next
            Set b = Nothing
        Next y
        Set a = Nothing
    Next x

End Sub

and the output

A   1   F1  R1
A   1   F2  R1
A   1   F3  R1
A   2   F1  R1
A   2   F2  R1
A   2   F3  R1
B   1   F1  R1
B   1   F2  R1
B   1   F3  R1
B   2   F1  R1
B   2   F2  R1
B   2   F3  R1
C   1   F1  R1
C   1   F2  R1
C   1   F3  R1
C   2   F1  R1
C   2   F2  R1
C   2   F3  R1
D   1   F1  R1
D   1   F2  R1
D   1   F3  R1
D   2   F1  R1
D   2   F2  R1
D   2   F3  R1
E   1   F1  R1
E   1   F2  R1
E   1   F3  R1
E   2   F1  R1
E   2   F2  R1
E   2   F3  R1

answered May 29, 2013 at 18:23

user2140173

2 Comments

user2425910 Over a year ago

Hi @mehow I ran the macro, however it didn't output any results into the worksheet

user2140173 Over a year ago

@user2425910 it wasn't told to do so:) if you click CTRL + G before/after running the code you will open a window in the VBE view called Immediate Window which is a debbuging console for VBA and your output will be there. You can modify the Debug.Print to output to a worksheet

shA.t · Accepted Answer · 2015-04-28 23:48:53Z

Try this VBA code:

Type tArray
    value As String
    count As Long
End Type

Sub combineAll()
    Dim sResult(10) As tArray, rRow(10) As Long, str() As String
    Dim sRow As Long, sCol As Long
    Dim i As Long, r As Long
    Dim resRows As Long
    sRow = 1: sCol = 1: r = 0

    With ActiveSheet
        Do
            rRow(sCol) = 1
            If (Trim(.Cells(sRow, sCol).value) = "") Then Exit Do
            Do
                If (Trim(.Cells(sRow, sCol).value) = "") Then Exit Do
                sResult(sCol).value = sResult(sCol).value & Trim(.Cells(sRow, sCol).value) & ";"
                sResult(sCol).count = sResult(sCol).count + 1
                sRow = sRow + 1
            Loop
            sCol = sCol + 1
            sRow = 1
        Loop

        Do
            r = r + 1
            For i = 1 To sCol - 1
                str = Split(sResult(i).value, ";")
                .Cells(r, sCol + i).value = str(rRow(i) - 1)
            Next i

            For i = sCol - 1 To 1 Step -1
                If rRow(i) < sResult(i).count Then
                    rRow(i) = rRow(i) + 1
                    Exit For
                Else
                    rRow(i) = 1
                End If
            Next i

            If rRow(1) >= sResult(1).count Then Exit Do
        Loop

    End With

End Sub

Collectives™ on Stack Overflow

Create combinations in Excel VBA

3 Answers 3

1 Comment

2 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

1 Comment

2 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related