• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Re-Arranging Columns - basis header Names - VBA codes using Array

Asheesh

Asheesh

Excel Ninja
Hi Guys - Here I am back at your doorsteps for some VBA help...

Note: I need to do it using VBA Arrays only..

I have a worksheet which has several headers in row 3, however, I am required to deal with only those columns where headers are "a", "b" and "c"..

These three columns can be placed anywhere in row 3...they can either be split or together or can be incorrectly arranged...

Now - what i want is -

I want to search for these column headers and then re-arrange them if required...Re-arranged order (a, b, c)..

To paste these ranges - we will see which column header appears first in row 3..and paste all the three columns there...

see the attached...

Please let me know if I havent explained it well..
 

Attachments

  • Re-Arranging Columns.xlsm
    17.4 KB · Views: 40
Asheesh said:
Note: I need to do it using VBA Arrays only..

…

I want to search for these column headers and then re-arrange them if required...Re-arranged order (a, b, c)..

To paste these ranges - we will see which column header appears first in row 3..and paste all the three columns there...
Click to expand...
1. To clarify 'VBA Arrays only'; you dont want to cut and paste/insert ranges, you want to put the data in array(s) in vba, then when vba manipulation finished, place the data upon the worksheet?
2. What to do if this overwrites existing data?
3. How do you determine the numbers of rows involved?
 
1) Yes you are right, I could copy paste the range, however, just for learning purposes, i want to perform this step using Arrays.
2) Overwriting data is not an issue because codes prior to this would move all the required data to a separate sheet.
3) Which ever column i.e.(Header "a" or "b" or "c") has the highest number of rows will be the number of rows involved..say if header "a" has 15 rows, "b" has 20 rows and "c" has 6 rows...and the max of these three headers is 20..so rows invloved are 20.

Hope this clarifies...
 
It's much easier to do this with ranges, however, try this on your sample sheet (the code operates on the active sheet and should go into a standard code-module (not a sheet code-module)):
Code: 
Sub blah()
Dim Destn As Range 'top left cell of where the final esults will be placed on the sheet.
Dim myResultsArray() 'will hold the final array to be placed on the sheet.
Dim Colms3Array(1 To 3) 'will hold the 3 cells being the header of each column, in order abc.
headerArray = Array("a", "b", "c") 'set up a list of things to search for, in order.
Set SearchRow = Intersect(ActiveSheet.UsedRange, Rows(3)) 'determine where to search for the 3 headers.
cn = 1 'used twice below to hold how far we've looped.
For Each Header In headerArray ' this takes the a b c in turn.
  Set aHdr = SearchRow.Find(what:=Header, Lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False) 'this finds them
  'aHdr.Select
  If Destn Is Nothing Then Set Destn = aHdr Else If aHdr.Column < Destn.Column Then Set Destn = aHdr 'sets the Destn using their column no. to find the leftmost one.
  If IsEmpty(aHdr.Offset(1)) Then aRw = 3 Else aRw = aHdr.End(xlDown).Row 'this line assumes contiguous values below the header and takes care if there's nothing below the header.
  Set Colms3Array(cn) = aHdr 'adds the header cell to the array fero later use
  maxRowNo = Application.Max(aRw, maxRowNo) 'holds the row no. of the longest column.
  cn = cn + 1
Next Header

RowCount = maxRowNo + 1 - 3  'convert the max row no. to a row count. Kept the 3 in there as it relates to row 3
ReDim myResultsArray(1 To RowCount, 1 To 3) 're dimension the final size of the array.
cn = 1
For Each Header In Colms3Array 'takes each of the three header cells in turn.
  With Header.Resize(RowCount) 'expands the range
    x = .Value 'puts the values into memory (x)
    .ClearContents 'clears tha column's contents - we've got the values in memory.
  End With
  For i = 1 To RowCount 'taking each cell of the column in turn (not really the cell, it's now x)..
    myResultsArray(i, cn) = x(i, 1) 'and put it into the final result array.
  Next i
  cn = cn + 1
Next Header
Destn.Resize(RowCount, 3) = myResultsArray 'puts the new array onto the sheet.
End Sub
 
One more solution found here:
http://www.mrexcel.com/forum/excel-questions/606890-reorder-columns-using-macro.html

For quick reference, code from above link:
Code: 
Sub Reorder_Columns()
'Code contribution by AlphaFrog (Excel MVP) in
'http://www.mrexcel.com/forum/excel-questions/606890-reorder-columns-using-macro.html
 
  Dim arrColOrder As Variant, ndx As Integer
  Dim Found As Range, counter As Integer
 
  'Place the column headers in the end result order you want.
  arrColOrder = Array("COLUMN2", "COLUMN4", "COLUMN6", "COLUMN10", "COLUMN1", _
  "COLUMN9", "COLUMN3", "COLUMN8", "COLUMN7", "COLUMN5")
 
  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

Regards,
Surendran
 
You must log in or register to reply here.
Back
Top