Help - VBA to automatically reorder columns

Hello,

Can anyone help me with code will automatically look at columns in an excel sheet and reorder them in a pre-specified order? We already have code that kicks out an error if the correct columns aren't in the excel file, but it has no concern over the order of them. Also, it is preferred that the code takes into account that there may be slight variances in column name - for instance, one group at my company may use a column named "Supplier Name", while another uses a column named "Supplier_Name". Any ideas?

Thanks,

Jon S

This is easily done.

Please supply a list of column names as well as alternate names

Thanks in advance for your help. Sorry if this is poorly formatted, but here they are:

Format:
Column Name - Alternate 1 - Alternate 2

supplier_name - Supplier - Supplier_ID
std_document_number - Doc Number - Doc_Number
std_revision - rev - revision_no
title - Title_Name - std_title
sched_subm_date - sub_date - Submittal
date_received_from_supplier - rec'd_supp - date rec'd
date_received_by_resp_pers - rec'd_resp - date rec'd_resp
date_received_in_dcc - rec'd_dcc - date rec'd_dcc
returned_to_supplier_subcon - to_supplier - date_supplier_subcon
document_status - doc status - doc_status
supplier_or_subcon_doc_nbr - supp_doc_nbr - sup_doc_nbr
supplier_or_subcon_doc_rev - supp_doc_rev - sup_doc_rev
responsible_person - RP - resp_person
Agreement_Nbr - agreement_no - Agree_no
equipment_number - equipment_no - Eq_no
distrib_code - distribution_code - dist_code
work_priority - work_pri - working_priority
supplier_xmtl_nbr - supp_xmtl_nbr - supp_xmtl_no

Thanks again for your help!

Hi

This macro seems to work.

Please give it a try.

Sub Macro1()
columnArray = Array("supplier_xmtl_nbr", "supp_xmtl_nbr", "supp_xmtl_no", "work_priority", "work_pri", "working_priority", "distrib_code", "distribution_code", "dist_code", "equipment_number", "equipment_no", "Eq_no", "Agreement_Nbr", "agreement_no", "Agree_no", "responsible_person", "RP", "resp_person", "supplier_or_subcon_doc_rev", "supp_doc_rev", "sup_doc_rev", "supplier_or_subcon_doc_nbr", "supp_doc_nbr", "sup_doc_nbr", "document_status", "doc status", "doc_status", "returned_to_supplier_subcon", "to_supplier", "date_supplier_subcon", "date_received_in_dcc", "rec'd_dcc", "date rec'd_dcc", "date_received_by_resp_pers", "rec'd_resp", "date rec'd_resp", "date_received_from_supplier", "rec'd_supp", "date rec'd", "sched_subm_date", "sub_date", "Submittal, title", "Title_Name", "std_title, std_revision", "rev", "revision_no", "std_document_number", "Doc Number", "Doc_Number", "supplier_name", "Supplier", "Supplier_ID")
On Error Resume Next
For Count = 0 To UBound(columnArray) Step 3
Offset = 0
    Rows("1:1").Select
10  If Offset > 2 Then GoTo 20
    ColName = columnArray(Count + Offset)
    Selection.Find(What:=ColName, After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    If LCase(ActiveCell.Value) <> LCase(ColName) Then Offset = Offset + 1: GoTo 10
    ActiveCell.EntireColumn.Select
    Selection.Cut
    Range("A1").Select
    Selection.Insert Shift:=xlToRight

20  Next
End Sub

After a little tweaking, works perfectly. Thanks for your help!