Move Columns Based on Header

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!
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,416
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
 

Shaner73

Board Regular
Joined
Jul 27, 2010
Messages
65
AlphaFrog...

I use this macro frequently. I am training other employees the function of this macro. However, I am running into a problem. After I run this, I do a Subtotal. Whatever data I use to Subtotal, I do a Find and Replace afterwards to delete, for example, (space)Count in whatever column the Subtotal ran in.

I get the following Error Message...

Microsoft Office Excel cannot find any data to replace. Check if your search formatting and criteria are defined correctly.If you are sure the matching data exists in this workbook, it may be on a protected sheet. Excel cannot replace data on a protected worksheet.

I have checked and the sheet is not protected. I can use a different code to rearrange the headers, but I like this one much better.

Any help will be appreciated.

Thanks,
Shane
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,416

ADVERTISEMENT

... I do a Find and Replace afterwards to delete, for example, (space)Count in whatever column the Subtotal ran in.

The message means it can't find anything that matches your search criteria; (space)Count.
I don't understand what you are searching for, but your search for criteria, (space)Count, is probably what needs to be changed.
 

Shaner73

Board Regular
Joined
Jul 27, 2010
Messages
65
The message means it can't find anything that matches your search criteria; (space)Count.
I don't understand what you are searching for, but your search for criteria, (space)Count, is probably what needs to be changed.

When I run a subtotal, I need to delete the " Count" or ' Average"...whatever I am subtotaling in that column.

The other macro that is run by another person uses the .Select method...or Cut and Paste. We can subtotal, then Find and Replace with no errors.

Is it possible that your macro changes something by using an array?

We like your macro as it's easier to maintain and it's faster.
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,416

ADVERTISEMENT

When I run a subtotal, I need to delete the " Count" or ' Average"...whatever I am subtotaling in that column.

The other macro that is run by another person uses the .Select method...or Cut and Paste. We can subtotal, then Find and Replace with no errors.

Is it possible that your macro changes something by using an array?

We like your macro as it's easier to maintain and it's faster.

Sorry but I am not following at all what you are doing or want to do. What other macro?

As a total guess, if you want to search within the formulas, change this...
LookIn:=xlValues

To this...
LookIn:=xlFormulas
 
Last edited:

Shaner73

Board Regular
Joined
Jul 27, 2010
Messages
65
Sorry but I am not following at all what you are doing or want to do. What other macro?

As a total guess, if you want to search within the formulas, change this...
LookIn:=xlValues

To this...
LookIn:=xlFormulas

Sorry I'm not being clear enough...I'm not sure any other way to explain what I'm doing. Thank you for trying to help...but changing Values to Formulas did not work. I appreciate it!
 

Vexorg

Board Regular
Joined
Oct 5, 2010
Messages
116
Hi Guys,

This worked very well for me and I was able to rearrange the columns as i had specified. Is it possible to insert a blank column into the string as a place holder?

So IE "Column1", "(place holders)", "Column3" etc
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,416
It's probably easiest to insert blank columns after sorting the columns with headers.

Code:
Sub Reorder_Columns()
    
    Dim arrColOrder As Variant, ndx As Integer
    Dim Found As Range, counter As Integer
    
    arrColOrder = Array("Header1", "Header2", "Header3", "Header4", "Header5", _
                        "Header6", "Header7", "Header8", "Header9", "Header10")
    
    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
    
    [COLOR="Green"]' Insert blank column B[/COLOR]
    [COLOR="Red"]Columns("B:B").Insert Shift:=xlToRight[/COLOR]

    Application.ScreenUpdating = True
    
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,133,243
Messages
5,657,575
Members
418,401
Latest member
B_A_M155

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
Top