VBA trying to copy each unique combination of whole columns to a new sheet

[PiPaPils]

Hi all!

I usually lurk in these forums for all my VBA questions. There are several real nuggets of advice and solutions. I am always able to combine code and learn of the solutions offered. However, I can't get the following problem fixed... Basically I got a dynamic amount of columns in one sheet. I want to compare all possible combinations of columns in a separate sheet. So if I got Column A t/m F on the main sheet, I want a sheet for column A & B, one sheet for A & C, one sheet for A & D, etc... until the last sheet that consists of E & F.

Main sheet:						Sheet 1:			Sheet 2:			Sheet 3:
ColumnA	ColumnB	ColumnC	ColumnD	ColumnE	ColumnF		ColumnA	ColumnB		ColumnA	ColumnC		ColumnA	ColumnD
16	13	17	12	16	19		16	13		16	17		16	12
8	5	9	10	3	4		8	5		8	9		8	10
13	11	15	16	13	18		13	11		13	15		13	16
13	16	6	20	2	19		13	16		13	6		13	20
11	18	5	15	8	18		11	18		11	5		11	15
14	16	17	15	13	19		14	16		14	17		14	15
9	10	9	10	9	20		9	10		9	9		9	10
2	6	3	15	1	9		2	6		2	3		2	15
6	18	20	15	14	15		6	18		6	20		6	15
10	14	8	2	11	20		10	14		10	8		10	2
15	1	15	8	19	11		15	1		15	15		15	8
16	5	12	17	20	11		16	5		16	12		16	17
18	10	13	7	3	8		18	10		18	13		18	7
15	17	9	6	6	18		15	17		15	9		15	6
14	15	3	14	14	9		14	15		14	3		14	14
10	8	15	14	10	7		10	8		10	15		10	14
15	7	18	19	9	1		15	7		15	18		15	19
19	7	14	2	7	10		19	7		19	14		19	2

<tbody>
</tbody>

The issue is that the amount of columns is dynamic. So sometimes its 10, sometimes 15 and it can run up to 20. I am currently struggling to get it done with a double column loop, but I think I am thinking in the wrong direction.

Is there anyone who can give me a push in the right direction ?

Thanks in advance,

Koen

 

[Rick Rothstein]

What is the first combination after you process the Columns A/F combination... ColumnB/ColumnC or ColumnB/ColumnA (the reverse of the first Column A processing)?

 

[mumps]

Try:

Sub CopyCols()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim lColumn As Long
    lColumn = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
    Dim x As Long
    For x = 2 To lColumn
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets("Sheet1").Range("A1:A" & LastRow).Copy Cells(1, 1)
        Sheets("Sheet1").Range(Sheets("Sheet1").Cells(1, x), Sheets("Sheet1").Cells(LastRow, x)).Copy Cells(1, 2)
    Next x
    Application.ScreenUpdating = True
End Sub

 

[PiPaPils]

Try:

Sub CopyCols()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim lColumn As Long
    lColumn = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
    Dim x As Long
    For x = 2 To lColumn
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets("Sheet1").Range("A1:A" & LastRow).Copy Cells(1, 1)
        Sheets("Sheet1").Range(Sheets("Sheet1").Cells(1, x), Sheets("Sheet1").Cells(LastRow, x)).Copy Cells(1, 2)
    Next x
    Application.ScreenUpdating = True
End Sub

Hi Mumps!

Thats certainly a step in the right direction! It runs "only" from A & B to A & F however. I could added the blue part to make it run for all B combinations as well. Ideally there is a way to loop this as well ofcourse

Sub CopyCols()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim lColumn As Long
    lColumn = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
    Dim x As Long
    For x = 2 To lColumn
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets("Sheet1").Range("A1:A" & LastRow).Copy Cells(1, 1)
        Sheets("Sheet1").Range(Sheets("Sheet1").Cells(1, x), Sheets("Sheet1").Cells(LastRow, x)).Copy Cells(1, 2)
    Next x
    
    
[COLOR=#0000ff][I]    For x = 3 To lColumn[/I][/COLOR]
[COLOR=#0000ff][I]        Sheets.Add after:=Sheets(Sheets.Count)[/I][/COLOR]
[COLOR=#0000ff][I]        Sheets("Sheet1").Range("B1:B" & LastRow).Copy Cells(1, 1)[/I][/COLOR]
[COLOR=#0000ff][I]        Sheets("Sheet1").Range(Sheets("Sheet1").Cells(1, x), Sheets("Sheet1").Cells(LastRow, x)).Copy Cells(1, 2)[/I][/COLOR]
[COLOR=#0000ff][I]    Next x[/I][/COLOR]
    
    Application.ScreenUpdating = True
    
    
    
    
    
    
    
End Sub

@Rick, the combination is not important since I am planning to use a worksheet loop afterwards. I want to run several statistical tests on every possible combination, and then combine it again in a summary sheet. I do not necessarily need both A & B and B & A, but if that's the simplest solution, they are welcome

 

[Rick Rothstein]

@Rick, the combination is not important since I am planning to use a worksheet loop afterwards. I want to run several statistical tests on every possible combination, and then combine it again in a summary sheet. I do not necessarily need both A & B and B & A, but if that's the simplest solution, they are welcome

Okay, give this macro a try. The code assumes your data is on a sheet named "Main" and it will insert a new sheet for each column combination that you want and name that inserted sheet with the column designations its data came from.

Sub ColumnsTwoByTwo()
  Dim R As Long, C As Long, Coff As Long, LastRow As Long, LastCol As Long, LastSht As String
  LastRow = Sheets("Main").Cells(Rows.Count, "A").End(xlUp).Row
  LastCol = Sheets("Main").Cells(1, Columns.Count).End(xlToLeft).Column
  LastSht = "Main"
  For C = 1 To LastCol - 1
    For Coff = C + 1 To LastCol
      With Sheets.Add(After:=Sheets(LastSht))
        .Name = Split(Columns(C).Address(0, 0), ":")(0) & "-" & Split(Columns(Coff).Address(0, 0), ":")(0)
        LastSht = .Name
        .Range("A1:B" & LastRow) = Application.Index(Sheets("Main").Cells, Evaluate("ROW(1:" & LastRow & ")"), Split(C & " " & Coff))
      End With
    Next
  Next
End Sub

 

[PiPaPils]

Thanks a lot guys!

@Rick, your solution works perfectly!