Duplicating Column Order

[mkacz7]

I want all the tabs to have the same column order (left to right) as on tab #1. Headers have the same column names. ( MFG, SERIAL, MODEL, etc.) Numerous tabs with 50 columns all mixed up. I've been manually moving the columns to the needed order on each tab. That can't be the way to solve this issue. Thanks for any guidance.

 

[Herakles]

I want all the tabs to have the same column order (left to right) as on tab #1. Headers have the same column names. ( MFG, SERIAL, MODEL, etc.) Numerous tabs with 50 columns all mixed up. I've been manually moving the columns to the needed order on each tab. That can't be the way to solve this issue. Thanks for any guidance.

Can you please send us a mini-sheet of tab 1.

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[mkacz7]

I need the green headers on tab #2 to match the same left to right column order as the yellow ones on tab #1. ( Very simplified data. My real data has 50 columns.)

TAG	Control Number	Manufacturer	Model		Control Number	TAG	Model	Manufacturer
234	953	GE Medical	Vivid		953	234	Vivid	GE Medical
789	567	GE Medical	Tee		567	789	Tee	GE Medical
235	789	GE Medical	AMX 4		789	235	AMX 4	GE Medical

 

[johnnyL]

Can I assume that vba (macro) code is the solution that you are looking for?

What row are the column headers in?

 

[Herakles]

I need the green headers on tab #2 to match the same left to right column order as the yellow ones on tab #1. ( Very simplified data. My real data has 50 columns.)

TAG	Control Number	Manufacturer	Model		Control Number	TAG	Model	Manufacturer
234	953	GE Medical	Vivid		953	234	Vivid	GE Medical
789	567	GE Medical	Tee		567	789	Tee	GE Medical
235	789	GE Medical	AMX 4		789	235	AMX 4	GE Medical

I need the green headers on tab #2 to match the same left to right column order as the yellow ones on tab #1. ( Very simplified data. My real data has 50 columns.)

TAG	Control Number	Manufacturer	Model		Control Number	TAG	Model	Manufacturer
234	953	GE Medical	Vivid		953	234	Vivid	GE Medical
789	567	GE Medical	Tee		567	789	Tee	GE Medical
235	789	GE Medical	AMX 4		789	235	AMX 4	GE Medical

This code will reorder the columns in all sheets apart from sheet 1 based upon the column order in row one of sheet 1.

Private Sub subMain()
Dim arrColOrder As Variant
Dim i As Integer
    
    ActiveWorkbook.Save
    
    Application.ScreenUpdating = False

    arrColOrder = Worksheets(1).Range("A1").CurrentRegion
    
    arrColOrder = Application.Transpose(arrColOrder)

    For i = 2 To Sheets.Count
    
        Call subReorderColumns(arrColOrder, Worksheets(i))

    Next i
    
    Application.ScreenUpdating = False
        
    MsgBox "Columns have been reordered.", vbOKOnly, "Confirmation"

End Sub

Private Sub subReorderColumns(arrColOrder As Variant, Ws As Worksheet)
Dim ndx As Integer
Dim Found As Range
Dim counter As Integer
Dim strRanges As String

    counter = 1
            
    For ndx = LBound(arrColOrder) To UBound(arrColOrder)
    
        Set Found = Ws.Rows("1:1").Find(arrColOrder(ndx, 1), LookIn:=xlValues, LookAt:=xlWhole, _
            SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    
        If Not Found Is Nothing Then
            strRanges = strRanges & vbCrLf & Found.Address
            If Found.Column <> counter Then
                Found.EntireColumn.Cut
                Ws.Columns(counter).Insert Shift:=xlToRight
                Application.CutCopyMode = False
            End If
            counter = counter + 1
        End If

    Next ndx
    
End Sub

 

[johnnyL]

The following is what I came up with:

Sub RearrangeColumnOrder()
'
    Dim ColumnNumber                As Long, ResultSheetColumnNumber    As Long
    Dim LastColumnOfDesiredColumns  As Long, LastColumnOfInputColumns   As Long
    Dim FoundHeaderColumnAddress    As Range
    Dim Search_Header               As String
    Dim wsInput                     As Worksheet, wsSource              As Worksheet
'
    Const HeaderRow                 As Long = 1                                                 ' <--- Set this to the row that the header row is in
    Const ResultSheet               As String = "ResultSheet"                                   ' <--- Set this to the sheet name of the result sheet
'
     Set wsInput = Sheets("Sheet2")                                                             ' <--- Set this to the sheet with the messed up column order
    Set wsSource = Sheets("Sheet1")                                                             ' <--- Set this to the sheet that has the columns in the order that you desire
'
    Application.ScreenUpdating = False                                                          ' Turn ScreenUpdating offf
'
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = ResultSheet                                  ' Add the result sheet to the workbook
'
    LastColumnOfDesiredColumns = wsSource.Cells(1, Columns.Count).End(xlToLeft).Column          ' Get last column # of the source sheet
    LastColumnOfInputColumns = wsInput.Cells(1, Columns.Count).End(xlToLeft).Column             ' Get last column # of the input sheet
'
    For ColumnNumber = 1 To LastColumnOfDesiredColumns                                          ' Loop through the desired columns order
        Search_Header = wsSource.Cells(1, ColumnNumber)                                         '   Get the desired Header name
'
        With wsInput
            Set FoundHeaderColumnAddress = .Range(.Cells(1, 1), .Cells(1, _
                    LastColumnOfInputColumns)).Find(Search_Header, LookIn:=xlValues)            '       Find the desired column header address from the wsSource
'
            If (Not FoundHeaderColumnAddress Is Nothing) Then                                   '       If the header is found then ...
                ResultSheetColumnNumber = ResultSheetColumnNumber + 1                           '           Increment ResultSheetColumnNumber
                .Cells(1, FoundHeaderColumnAddress.Column).EntireColumn.Copy _
                        Sheets(ResultSheet).Cells(1, ResultSheetColumnNumber)                   '           Save the desired column to the new sheet
            End If
        End With
    Next                                                                                        ' Loop back
'
    Application.ScreenUpdating = True                                                           ' Turn ScreenUpdating back on
End Sub