Move Columns Based on Header

M

Michael151

Board Regular
Joined
Sep 20, 2010
Messages
247
<!--[if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> </w:Compatibility> <w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel> </w:WordDocument> </xml><![endif]--><!--[if gte mso 10]> <style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0in 5.4pt 0in 5.4pt; mso-para-margin:0in; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman";} </style> <![endif]--> Hello all,

Just need a little help writing a macro that will rearrange columns in a worksheet based on the header.

Currently, my worksheets have up to 10 different unique column headers that need to be in a specific order (after running the macro).

However, the worksheets may not always contain all 10 unique headers, sometimes only 6 or 8. If this is the case, the macro should simply place the columns in order (skipping over those columns missing).

For example:

DFACBE becomes: ABCDEF

DFABE becomes: ABDEF

If columns need to be placed in a specific column, maybe a separate function that will delete empty columns if needed.

Any help would be most appreciated – thanks!
 
Sort by date Sort by votes

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
I have a sheet that imports into an external programme (Pertmaster), which through its import magic uses rows 1 and 2 when importing the data and mapping it to its internal tables - if the rows are out of sequence it falls down or imports the wrong data in the wrong internal tables. Additionally the headers in row 2 are not unique (i.e. Column B is titled Type and so is column I), and I can't rename them (otherwise it falls down on import). I cannot insert a new header line as that would mean the data pertmaster uses is a row out and won't import the data....argh!

I need the ability to rearrange the columns similar to the above coding but based on data held in say rows outside of my data range e.g. rows 152, 153 or 154 depending on which layout/scenario is selected from a drop down (there is the potential to have to add other layouts in the future). The problem being rows 150, 153 and 154 are based on a table that could grow. So I was going to name each series (e.g. Layout1, Layout2, Layout3), and then need the macro to sort the columns in numerical order based on the numer in them named ranges.

Reason being the pertmaster layout is not very user friendly, so would like to reorder, but then have to switch them back to import the data in pertmaster. The 3rd view is just an alternative user friendly one.

Your help would be greatly appreciated. Thanks.
 
Upvote 0
AlphaFrog said:
Replace the "Header1", "Header2"...etc., with the actual names of your column headers and place them in the order you want as a result.

Code: 
Sub Reorder_Columns()
    
    Dim arrColOrder As Variant, ndx As Integer
    Dim Found As Range, counter As Integer
    
    arrColOrder = Array([COLOR=Red]"Header1", "Header2", "Header3", "Header4", "Header5", _
                        "Header6", "Header7", "Header8", "Header9", "Header10"[/COLOR])
    
    counter = 1
    
    Application.ScreenUpdating = False
    
    For ndx = LBound(arrColOrder) To UBound(arrColOrder)
    
        Set Found = Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
                          SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        
        If Not Found Is Nothing Then
            If Found.Column <> counter Then
                Found.EntireColumn.Cut
                Columns(counter).Insert Shift:=xlToRight
                Application.CutCopyMode = False
            End If
            counter = counter + 1
        End If
        
    Next ndx
    
    Application.ScreenUpdating = True
    
End Sub
Click to expand...
I copied this straight into my code and I keep getting an error message at the "Set Found" line
I am so frustrated. It keeps says that script is out of range
I am at a loss
 
Upvote 0
Thank you AlphaFrog! This is perfect.

AlphaFrog said:
Replace the "Header1", "Header2"...etc., with the actual names of your column headers and place them in the order you want as a result.

Code: 
Sub Reorder_Columns()
    
    Dim arrColOrder As Variant, ndx As Integer
    Dim Found As Range, counter As Integer
    
    arrColOrder = Array([COLOR="Red"]"Header1", "Header2", "Header3", "Header4", "Header5", _
                        "Header6", "Header7", "Header8", "Header9", "Header10"[/COLOR])
    
    counter = 1
    
    Application.ScreenUpdating = False
    
    For ndx = LBound(arrColOrder) To UBound(arrColOrder)
    
        Set Found = Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
                          SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        
        If Not Found Is Nothing Then
            If Found.Column <> counter Then
                Found.EntireColumn.Cut
                Columns(counter).Insert Shift:=xlToRight
                Application.CutCopyMode = False
            End If
            counter = counter + 1
        End If
        
    Next ndx
    
    Application.ScreenUpdating = True
    
End Sub
Click to expand...
 
Upvote 0
Hi,

Thank you for the code and the accompanying explanations. I may have missed something (this is my first time attempting to use VBA in excel) but I'm not sure if any of the aforementioned code can address my problem:

My workbook has a master sheet where the core data (DealSheet) is located (only one column is important here: names of clients). This list of clients is continually growing and most importantly can be manipulated by users, including myself, with a sort function on any of the data columns in the DealSheet and so clients can appear in any, random, order.

There is another sheet (TaskSheet) in the workbook that displays a static number of tasks for each client (column header beginning in column F) and the level of completion for each task (descending down rows) in the corresponding cells. My goal is to rearrange the columns in the TaskSheet automatically based on whatever client sort takes place on the DealSheet. Additionally, I want the VBA function to be fluid...meaning I don't want to manually add an additional client in "quotes" every time a new client is brought on board and let the function do that work for me.

Any suggestions would be greatly appreciated! Thanks in advance for the time.

IM
 
Upvote 0
AlphaFrog said:
Replace the "Header1", "Header2"...etc., with the actual names of your column headers and place them in the order you want as a result.

Code: 
Sub Reorder_Columns()
    
    Dim arrColOrder As Variant, ndx As Integer
    Dim Found As Range, counter As Integer
    
    arrColOrder = Array([COLOR=Red]"Header1", "Header2", "Header3", "Header4", "Header5", _
                        "Header6", "Header7", "Header8", "Header9", "Header10"[/COLOR])
    
    counter = 1
    
    Application.ScreenUpdating = False
    
    For ndx = LBound(arrColOrder) To UBound(arrColOrder)
    
        Set Found = Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
                          SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        
        If Not Found Is Nothing Then
            If Found.Column <> counter Then
                Found.EntireColumn.Cut
                Columns(counter).Insert Shift:=xlToRight
                Application.CutCopyMode = False
            End If
            counter = counter + 1
        End If
        
    Next ndx
    
    Application.ScreenUpdating = True
    
End Sub
Click to expand...

This is so helpful, thank you! If you have say 30 columns, and on the next report you get there is only 29, but you still want it to leave a column gap for the missing column, how would you do this? E.g. the information in the 'original 30 column report' provides graphs/ further information, the fact that the information, so taking this away would alter the information. Hope that makes sense? Thanks!
 
Upvote 0
ng93x said:
This is so helpful, thank you! If you have say 30 columns, and on the next report you get there is only 29, but you still want it to leave a column gap for the missing column, how would you do this? E.g. the information in the 'original 30 column report' provides graphs/ further information, the fact that the information, so taking this away would alter the information. Hope that makes sense? Thanks!
Click to expand...


Code: 
[color=darkblue]Sub[/color] Reorder_Columns()
    
    [color=green]'This version inserts blank columns for missing headers[/color]
    
    [color=darkblue]Dim[/color] arrColOrder [color=darkblue]As[/color] [color=darkblue]Variant[/color], ndx [color=darkblue]As[/color] [color=darkblue]Integer[/color]
    [color=darkblue]Dim[/color] Found [color=darkblue]As[/color] Range, counter [color=darkblue]As[/color] [color=darkblue]Integer[/color]
    
    arrColOrder = Array("Header1", "Header2", "Header3", "Header4", "Header5", _
                        "Header6", "Header7", "Header8", "Header9", "Header10")
    
    counter = 1
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=darkblue]For[/color] ndx = [color=darkblue]LBound[/color](arrColOrder) [color=darkblue]To[/color] [color=darkblue]UBound[/color](arrColOrder)
    
        [color=darkblue]Set[/color] Found = Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
                          SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        
        [color=darkblue]If[/color] [color=darkblue]Not[/color] Found [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
            [color=green]'Move Column[/color]
            [color=darkblue]If[/color] Found.Column <> counter [color=darkblue]Then[/color]
                Found.EntireColumn.Cut
                Columns(counter).Insert Shift:=xlToRight
                Application.CutCopyMode = [color=darkblue]False[/color]
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Else[/color]
            [color=green]'Header not found[/color]
            [color=green]'Insert blank column with missing header[/color]
            Application.CutCopyMode = [color=darkblue]False[/color]
            Columns(counter).Insert Shift:=xlToRight
            Cells(1, counter).Value = arrColOrder(ndx)
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        
        counter = counter + 1
        
    [color=darkblue]Next[/color] ndx
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Upvote 0
AlphaFrog said:
Code: 
[COLOR=darkblue]Sub[/COLOR] Reorder_Columns()
    
    [COLOR=green]'This version inserts blank columns for missing headers[/COLOR]
    
    [COLOR=darkblue]Dim[/COLOR] arrColOrder [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], ndx [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] Found [COLOR=darkblue]As[/COLOR] Range, counter [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
    
    arrColOrder = Array("Header1", "Header2", "Header3", "Header4", "Header5", _
                        "Header6", "Header7", "Header8", "Header9", "Header10")
    
    counter = 1
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    
    [COLOR=darkblue]For[/COLOR] ndx = [COLOR=darkblue]LBound[/COLOR](arrColOrder) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](arrColOrder)
    
        [COLOR=darkblue]Set[/COLOR] Found = Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
                          SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        
        [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] Found [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
            [COLOR=green]'Move Column[/COLOR]
            [COLOR=darkblue]If[/COLOR] Found.Column <> counter [COLOR=darkblue]Then[/COLOR]
                Found.EntireColumn.Cut
                Columns(counter).Insert Shift:=xlToRight
                Application.CutCopyMode = [COLOR=darkblue]False[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]Else[/COLOR]
            [COLOR=green]'Header not found[/COLOR]
            [COLOR=green]'Insert blank column with missing header[/COLOR]
            Application.CutCopyMode = [COLOR=darkblue]False[/COLOR]
            Columns(counter).Insert Shift:=xlToRight
            Cells(1, counter).Value = arrColOrder(ndx)
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        
        counter = counter + 1
        
    [COLOR=darkblue]Next[/COLOR] ndx
    
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
Click to expand...

Thanks so much! I'll try this tomorrow! :) Really appreciate it!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
1K
Attrazion
A
M
  • Question
Build HTML Table based on Loop through Excel Worksheet Column / Row condition
Replies
0
Views
759
mystik5
M
Gerald Higgins
  • Question
VBA, make code move across from main file to extract file
Replies
9
Views
1K
Gerald Higgins
Gerald Higgins
D
  • Question
Variable in Ranges
Replies
5
Views
904
Fluff
Fluff
P
  • Question
vba to run through sorted list and copy rows in each sorted group into a new tab
Replies
3
Views
896
vcoolio
V

Forum statistics

Threads
1,214,923
Messages
6,122,286
Members
449,076
Latest member
kenyanscott

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top