Use Excel to find combinations

[faugrad]

I have a table with the following data (example):

Chris	Florida	1
Jamie	Texas	1
Samantha	Georgia	1
John	Maine	1
Jim	Wisconsin	1
Steve	Nebraska	2
Melanie	Florida	2
Hector	California	2
Susanna	Oregon	3
David	Kentucky	3

<tbody>
</tbody>

What I am trying to do is find a possible function in Excel that finds all possible combinations based on the digits in the last column. It should find all possible combinations except the ones based on the same number and put them next to each other. Example:

Chris	Florida	1	2	Nebraska	Steve
Chris	Florida	1	2	Florida	Melanie
Chris	Florida	1	2	California	Hector
Chris	Florida	1	3	Oregon	Susanna
Chris	Florida	1	3	Kentucky	David
Jamie	Texas	1	2	Nebraska	Steve
Jamie	Texas	1	2	Florida	Melanie
Jamie	Texas	1	2	California	Hector
Jamie	Texas	1	3	Oregon	Susanna
Jamie	Texas	1	3	Kentucky	David

<tbody>
</tbody>

And so on until I have all the combinations.

 

[Sandeep Warrier]

Hi,

Written in a hurry and untested, but does this help?

Change the sheet names/ranges to match your data.

Excel 2003
	A	B	C
1	Name	Place	Number
2	Chris	Florida	1
3	Jamie	Texas	1
4	Samantha	Georgia	1
5	John	Maine	1
6	Jim	Wisconsin	1
7	Steve	Nebraska	2
8	Melanie	Florida	2
9	Hector	California	2
10	Susanna	Oregon	3
11	David	Kentucky	3
Sheet1

Sub CopyStuff()
    Dim ws As Worksheet, ws1 As Worksheet
    Dim rng As Range, rcell As Range
    Dim LR As Long, lResize As Long
    
    Set ws = Sheets("Sheet1")
    Set ws1 = Sheets("Sheet2")
    
    Set rng = ws.Range("A1:C" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
    
    For Each rcell In Application.Index(rng, 0, 3)
        If IsNumeric(rcell.Value) Then
            LR = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row + 1
            With rng
                .AutoFilter Field:=3, Criteria1:="<>" & rcell.Value
                .Offset(1).Columns(3).SpecialCells(xlCellTypeVisible).Copy
                ws1.Range("D" & LR).PasteSpecial xlPasteValues
                .Offset(1).Columns(2).SpecialCells(xlCellTypeVisible).Copy
                ws1.Range("E" & LR).PasteSpecial xlPasteValues
                .Offset(1).Columns(1).SpecialCells(xlCellTypeVisible).Copy
                ws1.Range("F" & LR).PasteSpecial xlPasteValues
                lResize = ws1.Range("D" & ws1.Rows.Count).End(xlUp).Row
                .AutoFilter
                .Range(rcell, rcell.Offset(0, -2)).Copy
                ws1.Range("A" & LR & ":C" & lResize).PasteSpecial xlPasteValues
            End With
        End If
    Next rcell
    
End Sub

 

[faugrad]

Hi,

Written in a hurry and untested, but does this help?

Change the sheet names/ranges to match your data.

Excel 2003

	A	B	C
1	Name	Place	Number
2	Chris	Florida	1
3	Jamie	Texas	1
4	Samantha	Georgia	1
5	John	Maine	1
6	Jim	Wisconsin	1
7	Steve	Nebraska	2
8	Melanie	Florida	2
9	Hector	California	2
10	Susanna	Oregon	3
11	David	Kentucky	3

<COLGROUP><COL><COL><COL><COL></COLGROUP><THEAD>
</THEAD><TBODY>
</TBODY>

Sheet1​

Sub CopyStuff()
    Dim ws As Worksheet, ws1 As Worksheet
    Dim rng As Range, rcell As Range
    Dim LR As Long, lResize As Long
    
    Set ws = Sheets("Sheet1")
    Set ws1 = Sheets("Sheet2")
    
    Set rng = ws.Range("A1:C" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
    
    For Each rcell In Application.Index(rng, 0, 3)
        If IsNumeric(rcell.Value) Then
            LR = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row + 1
            With rng
                .AutoFilter Field:=3, Criteria1:="<>" & rcell.Value
                .Offset(1).Columns(3).SpecialCells(xlCellTypeVisible).Copy
                ws1.Range("D" & LR).PasteSpecial xlPasteValues
                .Offset(1).Columns(2).SpecialCells(xlCellTypeVisible).Copy
                ws1.Range("E" & LR).PasteSpecial xlPasteValues
                .Offset(1).Columns(1).SpecialCells(xlCellTypeVisible).Copy
                ws1.Range("F" & LR).PasteSpecial xlPasteValues
                lResize = ws1.Range("D" & ws1.Rows.Count).End(xlUp).Row
                .AutoFilter
                .Range(rcell, rcell.Offset(0, -2)).Copy
                ws1.Range("A" & LR & ":C" & lResize).PasteSpecial xlPasteValues
            End With
        End If
    Next rcell
    
End Sub

Thanks a lot! This is very close to what I need. There is one thing I noticed, it seems to take everything twice (mirrored). It does all combinations double like this, which I am trying to avoid:

Chris	Florida	1	2	Nebraska	Steve
Steve	Nebraska	2	1	Florida	Chris

<TBODY>
</TBODY>