VBA / Macro - Sort by ROW - Specific Requirement

[ExcelFabs]

Dear Community,

I have a daily report which is currently manually sorted. I would like to do this automated with a macro if possible.

The "Row Headers" look something like this:
[TABLE="width: 735"]
<tbody>[TR]
[TD]302(USD)[/TD]
[TD]304(EUR)[/TD]
[TD]305(USD)[/TD]
[TD]307(USD)[/TD]
[TD]308(USD)[/TD]
[TD]310(GBP)[/TD]
[TD]311(USD)[/TD]
[TD]342(EUR)[/TD]
[TD]368(EUR) ....[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
It can be any number between 300 - 599, followed by 3 currencies, USD, GBP, EUR in brackets. This changes everyday depending on the report.

We manually sort by Ascending Number + (USD), then (GBP), and lastly (EUR).
This is done by checking the header in Row 1, apply above condition, and cut-paste column to the correct Spot manually.
In the example above, i would manually cut out column with header 304(EUR) and paste it before column with header 342(EUR).

Is there a way to automate this with a Macro?

I tried using Custom Lists without success. Appreciate any help or guidance in this matter!


Let me know if anything is unclear or you need more information.

Thanks so much in advance,
Kind regards
ExcelFabs

 

[Peter_SSs]

Welcome to the MrExcel Board!

The "Row Headers" look something like this:

Do you mean Column headers here?

 

[ExcelFabs]

Hi Peter,

yes sorry. This should be "Column Headers" which can be found in Row 1.

 

[Peter_SSs]

OK, give this a try in a copy of your workbook.

Sub Rearrange_Columns()
  Dim AL As Object
  Dim itm As Variant
  Dim c As Range
  Dim Pref As String
  
  Set AL = CreateObject("System.Collections.ArrayList")
  For Each c In Range("A1", Cells(1, Columns.Count).End(xlToLeft))
    Select Case Right(c.Value, 5)
      Case "(USD)": Pref = "A"
      Case "(GBP)": Pref = "B"
      Case "(EUR)": Pref = "C"
    End Select
    AL.Add Pref & c.Value
  Next c
  AL.Sort
  AL.Reverse
  Application.ScreenUpdating = False
  For Each itm In AL
    Rows(1).Find(What:=Mid(itm, 2), LookAt:=xlWhole).EntireColumn.Cut
    Columns("A").Insert
  Next itm
  Application.ScreenUpdating = True
End Sub

 

[ExcelFabs]

Thanks so much Peter! This works perfectly

I only changed two things, to start at Column "C" as i had two fixed columns before. Perfect!


Thanks again, this is a GREAT help!

 

[Peter_SSs]

Thanks so much Peter! This works perfectly

I only changed two things, to start at Column "C" as i had two fixed columns before. Perfect!


Thanks again, this is a GREAT help!

I did woder if it was all columns or not.
Anyway, glad you could modify it yourself to do what was required.

 

[ExcelFabs]

I did woder if it was all columns or not.
Anyway, glad you could modify it yourself to do what was required.

While i unfortunately can't follow the whole code logic, at least i could figure out somewhat which part is doing what So i was able to amend those parts to fit.

Thanks again!

 

[Peter_SSs]