How to split a range of n columns into n parts and copy paste under eachother

[MrGambas]

Hi,

being a complete newbee in VBA I am struggling with something that is probably very simple.

I have a range that consists of any number of rows, and any number of columns, but not very many. Up to 500 rows and 30 columns. The columns may be grouped by a heading, and a group may be from 2 - 5 columns. It will always be the same number of columns in a group.

What I want to do is to move these groups under each other.

Let's say that the range has 20 rows, and 18 columns. Each group of columns has 3 columns. (Col 1-3 belongs together, 4-6, 7-9 and so on) Then I want col 4-6 to be moved under 1-3, 7-9 under 4-6 and so on.

This is my code so far:

Sub MoveCols()

Dim mR As Range

On Error Resume Next

Set mR = Application.InputBox("Select your Range", , , , , , , 8)
If mR Is Nothing Then MsgBox "Nothing Selected!", vbExclamation: Exit Sub
On Error GoTo 0

Dim HowManyTimes As Integer: HowManyTimes = 1

mR.Copy mR.Offset(mR.Rows.Count).Resize(mR.Rows.Count * HowManyTimes)
End Sub


The ideal solution would be that after I have selected to complete range, from i.e. "A1: R20" I will get a new inputbox where I can enter a number representing the number of columns in each group. When this is done the range is being split by the number in the inputbox, and each group is moved under each other. So if I enter 3 there will be in total 6 groups with 3 columns in each. The range will of course always be split into a number that matches the total number of columns.

Could anyone please point me into the right direction on how to do that?

 

[mumps]

Try:

Sub SplitColumns()
    Application.ScreenUpdating = False
    Dim x As Long, lCol As Long, response As String
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column
    lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    response = InputBox("Please enter the number of columns to group.")
    If response = "" Then Exit Sub
    For x = response + 1 To lCol Step response
        Cells(1, x).Resize(lastrow, response).Copy Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next x
    Range(Columns(response + 1), Columns(lCol)).Delete
    Application.ScreenUpdating = True
End Sub

 

[MrGambas]

That works absolutely perfect! Now I will have a beer and study your code and try to learn something from it.

Thank you very much!!

 

[mumps]

You are very welcome.

 

[Peter_SSs]

Just stumbled on this thread and understand that vba was requested but note that with recent functions available in Excel this can also be achieved with a single formula in a single cell.
Small example:

22 06 28.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Z	E	C	D	F	H	A	J	X	Cols/Group		Z	E	C
2	A	P	F	L	R	N	L	Q	Q	3		A	P	F
3	H	R	R	J	S	N	P	G	W			H	R	R
4	O	G	I	O	E	K	W	J	Y			O	G	I
5	H	L	H	S	I	S	S	O	R			H	L	H
6	Q	L	Y	O	J	V	Q	Y	B			Q	L	Y
7	V	B	U	W	A	D	B	I	H			V	B	U
8	X	Z	O	K	I	S	W	O	B			X	Z	O
9	A	U	V	E	D	R	T	T	E			A	U	V
10												D	F	H
11												L	R	N
12												J	S	N
13												O	E	K
14												S	I	S
15												O	J	V
16												W	A	D
17												K	I	S
18												E	D	R
19												A	J	X
20												L	Q	Q
21												P	G	W
22												W	J	Y
23												S	O	R
24												Q	Y	B
25												B	I	H
26												W	O	B
27												T	T	E
28
MAKEARRAY

Cell Formulas
Range	Formula
L1:N27	L1	=LET(r,A1:I9,rws,ROWS(r),cols,COLUMNS(r),MAKEARRAY(rws*cols/J2,J2,LAMBDA(rw,col,INDEX(r,MOD(rw-1,rws)+1,INT((rw-1)/rws)*J2+col))))
Dynamic array formulas.

 

[MrGambas]

Great, thanks!