Excel/VBA

Advertisement


Question
QUESTION: Hi Tom

I wish to rearrange some column headings according to a key that is placed in range A1:A52 (Sheet1)  The column  headings  and contents that I wish to rearrange are in Sheet2 starting at cell A1

The key is as follows :
(column letter/heading)
A Name
B Year
C Gender
D Blank1
E Blank2
F FSM

The data in Sheet2 has these column headings but in a completely different order.

Is this achievable with code?  If it is and its complexity does not require a great deal of time to write, could you write it for me?

Thanks in advance.

Chris Mitchell

ANSWER: Christopher Mitchell,

See if this does what you want:  (test on a copy of your workbook)

Sub rearrangecolumns()
Dim s As String, v As Variant, r As Range, cell As Range
Dim i As Long, r1 As Range
s = "{""A"",""Name"";""B"",""Year"";""C"",""Gender"";" & _
"""D"","""";""E"","""";""F"",""FSM""}"
v = Evaluate(s)
'For i = LBound(v, 1) To UBound(v, 1)
'  Debug.Print v(i, 1), v(i, 2)
'Next

For i = LBound(v, 1) To UBound(v, 1)
 Set r = Range("A1", Cells(1, Columns.Count).End(xlToLeft))
 If Len(Trim(v(i, UBound(v, 2)))) <> 0 Then
   For Each cell In r
     If LCase(cell.Value) = LCase(v(i, UBound(v, 2))) Then
       Set r1 = Cells(1, v(i, LBound(v, 1))).EntireColumn
       cell.EntireColumn.Copy
       r1.Insert shift:=xlToRight
       cell.EntireColumn.Delete
       Exit For
     End If
   Next
 Else
    Set r1 = Cells(1, v(i, LBound(v, 1))).EntireColumn
    r1.Insert shift:=xlToRight
 End If
Next
End Sub

--
Regards,
Tom Ogilvy


---------- FOLLOW-UP ----------

QUESTION: This works perfectly Tom.  Just one question:  which part of the code refers to the sheet name, just in case I should wish to adapt it?

regards

Chris Mitchell

ANSWER: Christopher Mitchell,

For some reason, I didn't actually pay attention to your introduction on how to convey the new column order.  So I have adapted the code to look at column  A of Sheet1 as you stated.  in A1 it expects to see

a1: "A Name"
a2: "B Year"
a3: "C Gender"
a4: "D"
a5: "E"
a6: "F FSM"
(without the double quotes).

The column letters of the new arrangement should be in order from leftmost column to rightmost column.   The code inserts new blank columns for an entry like A4 and A5.  If you actually had a column name, Blank1  for example, then you would enter it as

D Blank1

and it would process the same as any other column with a column header name

as written, you can't address 3 letter columns - it could be adjusted to do this.

Sub rearrangecolumns()
Dim s As String, v As Variant, r As Range, cell As Range
Dim i As Long, r1 As Range
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet2")   ' Data sheet
Set sh2 = Worksheets("Sheet1")   ' sheet with new column order in column A

Set r2 = sh2.Range("A1").CurrentRegion.Resize(, 1)
ReDim v(1 To r2.Rows.Count, 1 To 2)

i = 0
For Each cell In r2
i = i + 1
v(i, 1) = Trim(Left(cell, 2))
On Error Resume Next
v(i, 2) = Mid(cell.Value, 3, 255)
If Err.Number <> 0 Then
  v(1, 2) = ""
End If
On Error Resume Next
Next


'For i = LBound(v, 1) To UBound(v, 1)
'  Debug.Print v(i, 1), v(i, 2)
'Next

For i = LBound(v, 1) To UBound(v, 1)
 Set r = sh1.Range("A1", sh1.Cells(1, Columns.Count).End(xlToLeft))
 If Len(Trim(v(i, UBound(v, 2)))) <> 0 Then
   For Each cell In r
     If LCase(cell.Value) = LCase(v(i, UBound(v, 2))) Then
       Set r1 = sh1.Cells(1, v(i, LBound(v, 1))).EntireColumn
       cell.EntireColumn.Copy
       r1.Insert shift:=xlToRight
       cell.EntireColumn.Delete
       Exit For
     End If
   Next
 Else
    Set r1 = sh1.Cells(1, v(i, LBound(v, 1))).EntireColumn
    r1.Insert shift:=xlToRight
 End If
Next
End Sub



--
Regards,
Tom Ogilvy



---------- FOLLOW-UP ----------

QUESTION: And finally, can I add more items to the list?


a1: "A Name"
a2: "B Year"
a3: "C Gender"
a4: "D"
a5: "E"
a6: "F FSM"

regards

Chris Mitchell

Answer
Christopher Mitchell,

click in cell A1 of sheet1.  Do Ctrl+Shift+8

it should select all data that is contiguous.  The code does just that, and then takes just column A from that.  

Set r2 = sh2.Range("A1").CurrentRegion.Resize(, 1)

If you add data, then it should include that data in the column layout/specification.

--
Regards,
Tom Ogilvy  
About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.