Descending Horizontal Sort with Merged Cells

[reberryjr]

I have been tasked with building a scorecard of sorts and have come across a question during the design. I'm thinking of having something similar to the below image. The data will need to display a rolling 12 month history, so ideally I would have the most recent month on the left (think descending order). I will need to use VBA as there are multiple source inputs I need to leverage. I'm struggling with an intelligent way of displaying the data in the desired manner. The best I've been able to come up with is to copy the existing data set, paste it a few columns over and then plug the new data in the recently vacated cells. That seems inefficient.

P.S. Don't focus on the percentages, as the data is all very fictitious at this point.

 

[Ezguy4u]

So just to be clear, the example above should have Mar-23 on the left where Jan-23 is located. If that is the case how about a vba program that would insert an April-23 scorecard thus moving everything to the right? We need to start someplace.

 

[Peter_SSs]

To further help clarify:
What range of cells are we looking at in your image? (Using XL2BB for your sample data would automatically tell us that & also let us easily copy for testing)

It is also a bit unclear as to whether your requirement is to sort the existing data (suggested by the thread title) and/or to insert new columns for the next month (suggested by your description)
You could try this, after modifying ranges to suit your data, if the task is to sort the existing data.

I have assumed that the range shown is columns C:T starting in row 1.

Sub Sort_Months()
  Dim nr As Long, lc As Long, NumMerged As Long, c As Long
  
  nr = Columns("C:T").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
  lc = Cells(4, Columns.Count).End(xlToLeft).Column
  Application.ScreenUpdating = False
  With Range("C1", Cells(nr, lc))
    NumMerged = .Cells(1, 1).MergeArea.Columns.Count
    .Rows(1).MergeCells = False
    .Rows(.Rows.Count).FormulaR1C1 = "=IF(R1C="""",RC[-1],R1C)"
    .Sort Key1:=.Rows(.Rows.Count), Order1:=xlDescending, Header:=xlNo, Orientation:=xlLeftToRight
    .Rows(.Rows.Count).ClearContents
    For c = 1 To lc - .Column + 1 Step NumMerged
      .Cells(1, c).Resize(, NumMerged).MergeCells = True
    Next c
  End With
  Application.ScreenUpdating = True
End Sub

For code to insert new columns at the left ready for the next month you could try this

Sub New_Month_Columns()
  Dim NumMerged As Long
  
  NumMerged = Range("C1").MergeArea.Columns.Count
  Application.ScreenUpdating = False
  Columns("C").Resize(, NumMerged).Insert
  With Columns("C").Offset(, NumMerged).Resize(, NumMerged)
    .Copy
    .Offset(, -NumMerged).PasteSpecial xlPasteFormats
  End With
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

 

[reberryjr]

Unfortunately, my work laptop will not allow me to use XL2BB. The range of cells displayed is B11:S18. That particular table displays 3 months of data. Ultimately, it will need to display a rolling 12 months of data. Depending on the work product, there could be 8 additional tables of a similar nature, but with different column layouts. It seems like my best bet at this time is going to be to cut the data and paste it to allow enough room for the new month's data.