How to re-arrange columns based on the cell value

[ThrottleWorks]

Hi,

Please find attached file for more details.
I want to re-arrange columns in serial based on the cell value.

Can anyone please help me in this.

 

[Khalid NGO]

Hi Sachin, Good day...

If you are looking for formula based solution, try this in Output sheet, cell D1:
=SMALL(Input!$D$1:$O$1,COLUMN(A1))
Copy across to O1

And this in D2:
=INDEX(Input!$D$2:$O$13,ROW(A1),MATCH(D$1,Input!$D$1:$O$1,0))
Copy down and across to O13

Change the cell format to this to avoid zeros:
General;General;

Regards,

 

[Chihiro]

You can do something like this.

Sub test()
Dim sortArray As Object
Dim tempDic As Object, colDic As Object
Dim lRow As Long
Dim cel As Range

Set sortArray = CreateObject("System.Collections.ArrayList")
Set tempDic = CreateObject("Scripting.Dictionary")

lRow = Cells(Rows.Count, 4).End(xlUp).Row - 1

Cells(1, 1).Resize(lRow + 1, 3).Copy Sheets("Output").Cells(1, 1)

For Each cel In Range("D1:O1")
    tempDic.Add Item:=Range(cel, cel.Offset(lRow)), Key:=cel.Value
    sortArray.Add cel.Value
Next

sortArray.Sort

Set colDic = CreateObject("Scripting.Dictionary")
For i = 0 To sortArray.Count - 1
    colDic.Add Item:=tempDic.Item(sortArray(i)), Key:=sortArray(i)
Next

i = 4
For Each Key In colDic.Keys
    colDic.Item(Key).Copy Sheets("Output").Cells(1, i)
    i = i + 1
Next

Set sortArray = Nothing
Set tempDic = Nothing
Set colDic = Nothing

End Sub

 

[ThrottleWorks]

Hi @Khalid NGO ,sorry for late reply. I was looking for VBA solution. My mistake, did not explain it properly. Have a nice day ahead.

Hi @Chihiro sir, thanks a lot for the help. It is working great. Have a nice day ahead.

 

[Marc L]

Hi !

Sachin, maybe I missed something but
for this need at a very very very beginner level
why do not use the very Excel basics like Sort ? (so easy !)
And just using Macro recorder you have a code base !

At end it's a tiny code easier to maintain :​

Sub Demo()
     Application.ScreenUpdating = False
With Worksheets(2)
         .UsedRange.Clear
          Worksheets(1).UsedRange.Copy .Cells(1)
    With .UsedRange.Columns
      If .Count > 4 Then .Item(4).Resize(, .Count - 3).Sort .Cells(4), xlAscending, Header:=xlNo, Orientation:=xlLeftToRight
    End With
          Application.Goto .Cells(1), True
End With
     Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Chihiro]

Oh yes. Forgot about left to right sort.

 

[ThrottleWorks]

Hi @Marc L sir, sorry for late reply, to be honest that I can sort columns also.

Have a nice day ahead.

 

[Marc L]

As you can see in sort assistant window …​