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!
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Sort by date Sort by votes
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
 
Upvote 0
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.
Click to expand...

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
 
Upvote 0
Shaner73 said:
... I do a Find and Replace afterwards to delete, for example, (space)Count in whatever column the Subtotal ran in.
Click to expand...

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.
 
Upvote 0
AlphaFrog said:
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.
Click to expand...

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.
 
Upvote 0
Shaner73 said:
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.
Click to expand...

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:
Upvote 0
AlphaFrog said:
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
Click to expand...

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!
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

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

Forum statistics

Threads
1,224,595
Messages
6,179,798
Members
452,943
Latest member
Newbie4296

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