Excel - Macro to rearrange/add columns in all the sheets based oncolumn header

[avi]

Hi,

I need to rearrange columns on many sheets in a certain order based on
on column header.
For example, my columns might come into my spreadsheet as
C,B,D,G,A,H,I,F , or as F,B,C,A,D etc.
I want them all sorted say A,B,C,D - the rest of the columns is
irrelevant.

How do I accomplish this ?
TIA

 

[Andrew]

What about the sort function Data/Sort prior to xl2007. I recorded a
macro while doing this:

Selection.Sort Key1:=Range("B4"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight

Presumably you could loop through all the sheets of interest and run
this code for each. You'd need to determine the size of your data
range in each sheet (or is it always the same?). Post back if this is
close to what you were looking for and I'll develop it a bit further.

Rgds,
Andrew

 

[avi]

Andrew, note that I just want to reorder columns C, A, B into A, B, C
not to sort data in columns.
There is a similar post on this group -> macro "Sub blah()" ; that's
what I want but not on a new sheet but I want to be able to run it
across all the existing sheets.

Antonio

 

[Monarch]

Since i do not know if you have any unique identification of columns,
I'll assume that in first cell (row 1) there are letters for columns...


Sub MoveandCountColumns()
10 For i = 1 To 254 'As 255 is maximum number of columns

If Len(Cells(1, i).Value) = 0 Then Exit For 'This is end of columns

If Columns(Cells(1, i).Value).Column <> i Then
Columns(Cells(1, i).Value).Select
Selection.Copy
Columns(255).Select
ActiveSheet.Paste

Columns(i).Select
Selection.Copy
Columns(Cells(1, i).Value).Select
ActiveSheet.Paste

Columns(255).Select
Selection.Copy
Columns(i).Select
ActiveSheet.Paste
GoTo 10
End If
Next

I'm usind column 255 as temporary column for data that should be removed.
I'll try to explain... If in first column you have C and in third you
have E then i'll copy E column to column 255 then copy first column to
its right place and then put back column 255 content in first columns...
before macro i had C A E, after i have E X C, what means that i C is in
right place so i start from begin again until all columns are in right
places.


Here you will need some loops to identify what column on what place you
will need.
If you can provide

 

[avi]

Hi Monarch,

Since i do not know if you have any unique identification of columns,
I'll assume that in first cell (row 1) there are letters for columns...

Answer to your query is YES. ROW 1 contains unique identification of
columns.
I want to arrange couple of columns across all the sheets in the same
way since I have them now randomly placed across sheets in different
columns. Namely these are: "NUM", "SYS", "DIA", "TAG" etc...

Your code works perfectly on one sheet where 1st row (as you said) has
letters but can you help me with this.
TIA

 

[Monarch]

Ok, here is solution

Sub MoveandCountColumnsA()
10 For i = 1 To 254 'As 255 is maximum number of columns

If Len(Cells(1, i).Value) = 0 Then Exit For 'This is end of columns
col = ColumnPlace(Cells(1, i).Value, i)
If col <> i Then
Columns(col).Select
Selection.Copy
Columns(255).Select
ActiveSheet.Paste

Columns(i).Select
Selection.Copy
Columns(col).Select
ActiveSheet.Paste

Columns(255).Select
Selection.Copy
Columns(i).Select
ActiveSheet.Paste
GoTo 10
End If
Next

End Sub

and ColumnPlace Function. This function determine what is column
identifier and in which column should it move data.
You can add in CASE what is column header and where you wish it to put
that column.
Do not chage "Case else" part...


Public Function ColumnPlace(ColumnName, CurrColumn)
Select Case ColumnName
Case "NUM"
ColumnPlace = 1
Case "SYS"
ColumnPlace = 2
Case "DIA"
ColumnPlace = 3
Case "TAG"
ColumnPlace = 4
Case "VAR2"
ColumnPlace = 5
Case Else
ColumnPlace = CurrColumn
End Select
End Function

This code will move every column on its needed place only if that column
is mentioned in ColumnPlace function

 

[avi]

Hi,

While I was waiting on a reply, I modified the code found on
http://www.pcreview.co.uk/forums/thread-2587219.php
in such way that I am pasting copied columns from clipboard by
inserting it to the left of the first column (A).
It also works but I can't manage to run it across all the sheets in
workbook.
Note: there is a limitation in my code (as far I can see) that first
column in all the sheets needs to have the same header. Otherwise, if
the first column is to be pasted on the left of it - there's error. (I
don't have code with me now, but will post it next week when I am back
at work. Basically it is very close to the code on the link above )...
Luckily, all my sheets start with the same header in column A so I am
able to arrange it.

The code you posted ( thanx very much for it ) works perfectly on one
sheet.
However there is also limitation that there shall be no blank column
between columns of interest ie if there is blank on between, say "NUM"
& "SYS" nothing happens.
Also, please note that I wanted to run it across all the sheets in a
workbook.

 

[avi]

Well there is also another option as advised by Ax on Dbforums to use
Data|Sort, Options and Under Orientation, select "Sort left to
right".
The only thing needed here is Custom List that defines desired columns
order. (see below OrderCustom:=6)

----------------------
Sub Macro1()
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=6, MatchCase:=False, Orientation:=xlLeftToRight,
_
DataOption1:=xlSortNormal
End Sub

 

[Monarch]

here is complete solution
Does not stop on blank cell (it stops if there are 3 (userdefined) blank
cell in a row)
If works on all sheets in a workbook
Custom list can be arranged in ColumnPlace function (just insert new
case line with whatever content of column and desired place of column

here is code:

Sub MoveandCountColumnsA()

Static CountBlanks
'Next two lines cycle thru worksheets
For Each a In Worksheets
a.Activate

10 For i = 1 To 254 'As 255 is maximum number of columns

If Len(Cells(1, i).Value) = 0 Then
CountBlanks = CountBlanks + 1
'If there is 3 columns in a row that was blank assume last column
If CountBlanks > 3 Then
'3 blanks in a row, assume we are over last column
Exit For
End If
Else
'Reset counter if there is only 1 or 2 blank cells
CountBlanks = 0
End If
col = ColumnPlace(Cells(1, i).Value, i)
If col <> i Then
Columns(col).Select
Selection.Copy
Columns(255).Select
ActiveSheet.Paste

Columns(i).Select
Selection.Copy
Columns(col).Select
ActiveSheet.Paste

Columns(255).Select
Selection.Copy
Columns(i).Select
ActiveSheet.Paste
GoTo 10
End If
Next
Next

End Sub

Public Function ColumnPlace(ColumnName, CurrColumn)
Select Case ColumnName
Case "NUM" 'Put here content of first cell of column
ColumnPlace = 1 'Put here desired place of column
Case "SYS"
ColumnPlace = 2
Case "DIA"
ColumnPlace = 3
Case "TAG"
ColumnPlace = 7
Case "VAR2"
ColumnPlace = 5
Case Else
ColumnPlace = CurrColumn
End Select
End Function

And avi, you are welcome, if there is anything you would like me to
change, just ask

 

[avi]

Well, all I can say: Thanx very much Monarch!
Finally I can rearrange it now...

 

[KVandal]

Hi all

This post has been tremendously helpful for me, but I wondered if someone could help me take it further.

For my purposes, I usually have a number of sheets with some common columns between all the sheets, some common columns between some sheets and some columns unique to only one sheet.

These columns need to be arranged such that they align across all sheets for entry into our data system, ie. if sheet 1 and 2 both have a column headed "date", it should be in the same column, eg. column C. if only one of them has a particular column, then that column should remain blank in the other. There are frequently over 50 unique fields.

So, the above code is very helpful, but what I would ideally like is for a way to more easily assign the order of the columns. One idea I had was for a first macro to run through all the sheets and identify all the unique headings. This would then be represented in a separate sheet within the workbook and the user could drag and drop the column headings within a list, as desired (a vertical list - easier to read).

The MoveandCount sub would then use this list to assign the column numbers to each heading and sort the sheets accordingly.

A final (minor) complexity is that sometimes the column headers are 1, 2 or even 3 rows. I think there would have to be a user input at the start to say how many header rows there were (this would be standard for the whole workbook, rather than varying by sheet) and then use the concatenate function to create the unique column identifier.

Can anyone help with this? Is there a more elgant way than what i have proposed?

many thanks in advance.