Help with Ranking and Rearranging Columns

sham.shah · May 4th 2020

I am trying to sort columns based on their rank.

Code

Range("RankRange").Find("4").Address

However, I look for the column number each rank - I keep getting an error. I am new at VBA. When I copy and paste the values in the cells and then do the find it works. Not sure what to do. Finally, I want to sort the columns based on the rank in ascending order. If someone can help with this, it would be much appreciated. Thank you.

Code

Sub Macro10()
' Ranks and Column Re-arranging on CT_Calc Sheet
Dim CTRank As Integer
MyRows = Cells(Rows.Count, 1).End(xlUp).Row
MyColumns = Cells(1, Columns.Count).End(xlToLeft).Column
Range("A1").Offset(708, 0).Select
ActiveCell = "RankCT"
Range(Cells(MyRows, 2), Cells(MyRows, MyColumns)).Name = "CTRange"
For CTRank = 1 To MyColumns - 1
Range("A1").Offset(MyRows, CTRank).FormulaR1C1 = "=RANK(R[-1]C[0], CTRange, 1)"
Next CTRank
Range(Cells(MyRows + 1, 2), Cells(MyRows + 1, MyColumns)).Name = "RankRange"
MsgBox Range("RankRange").Find("4").Address
End Sub

Display More

dangelor · May 4th 2020

I may be reading this wrong, but I don't think Excel can sort a horizontal range . Can you post a sample workbook showing what it is you are attempting to do?

sham.shah · May 4th 2020

I am trying to re-order the columns as per ascending rank. So I was hoping to get the relevant column number from the rank and copy and insert it ahead of a higher rank column. If that works

dangelor · May 5th 2020

Sorry, but the workbook you upload is not workable. So many named ranges that it runs out of memory even if I try to copy something. Also, I don't see what it is you are trying to accomplish - I see columns of data but which are you attempting to rank? on which worksheet?

A simpler example would be more useful - one worksheet with some data and totals of some kind to rank, and one worksheet with the expected results of the ranking.

sham.shah · May 5th 2020

I have attached the simplified sheet. I want to achieve the following

1. Rank the Sum Totals of each column (ROW 708), for that the VBA code is inserting the Rank formula in the row below the totals.

2. Following in the rank, I want to rearrange each of the columns so the the smallest rank column is first, followed by the second, until the nth column

3. After that I want to sort the contents of each column in Descending order, column 1 first, then column 2, until nth column.

I hope this is clear. Thank you.

sham.shah · May 5th 2020

I tried another code, that sort of works in finding the rank and reordering the columns.

It goes haywire if the column is in its correct place (Column 1 is already in column 1, then it can't insert a column before it and paste) and also for the last column, as it is also in the correct place. How do i correct this?

Code

Sub Macro1()
'
' Macro1 Macro
'
'
MyRows = Cells(Rows.Count, 1).End(xlUp).Row
MyColumns = Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(MyRows, 2), Cells(MyRows, MyColumns)).Name = "RankRange"
Range("RankRange").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
For CSortCounter = 1 To MyColumns
rFind = Range("RankRange").Find(What:=CSortCounter).Column
MsgBox (rFind)
Columns(rFind).Select
Application.CutCopyMode = False
Selection.Cut
Columns(CSortCounter + 1).Select
Selection.Insert Shift:=xlToRight
Next CSortCounter
End Sub

Display More

dangelor · May 5th 2020

This worked on the file in post #5

Code

Sub Macro1_revised()
Dim MyRows As Long, MyColumns As Long
Dim CSortCounter As Long, rFind As Range
With ThisWorkbook.Worksheets("CT_Calc")
MyRows = .Cells(.Rows.Count, 1).End(xlUp).Row
MyColumns = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(MyRows, 2), .Cells(MyRows, MyColumns)).Name = "RankRange"
.Range("RankRange").Value = .Range("RankRange").Value
For CSortCounter = 1 To MyColumns - 1
Set rFind = Range("RankRange").Find(What:=CSortCounter)
rFind.EntireColumn.Copy .Columns(MyColumns + 1)
.Columns(rFind.Column).Delete
Next CSortCounter
.Sort.SortFields.Clear
For CSortCounter = 2 To MyColumns
.Sort.SortFields.Add2 Key:=.Columns(CSortCounter), Order:=xlDescending
Next CSortCounter
.Sort.SetRange Cells(2, 2).CurrentRegion
.Sort.Header = xlYes
.Sort.Apply
End With
End Sub

Display More

Help with Ranking and Rearranging Columns

Share

Tags