Reorder sheets and color tabs based on list

[willastrowalker]

I have a workbook that I want to reorder and recolor based on a list of sheetnames and color indexes on a tab.. I have working code for reordering, but want to add in code to recolor the tabs.

List of Sheet for ordering is in column A, color codes are in column B (total number of sheets changes, so need the color index to change with the list)

Sub Sort_Sheets()  Dim i As Long
  Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
  
  With Sheets("SheetOrder")
    On Error Resume Next
    For i = .Range("A" & .Rows.Count).End(xlUp).Row To 1 Step -1
      Sheets(.Cells(i, 1).Value).Move Before:=Sheets(1)
    Next i
    On Error GoTo 0
  End With
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic


End Sub

 

[My Aswer Is This]

Try this:

Remember now we only have 56 colorindex colors so never enter any value in column 2 greater then 56

Sub Sort_Sheets()
'Modified  9/14/2018  5:26:03 PM  EDT
Dim i As Long
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
  
  With Sheets("SheetOrder")
    On Error Resume Next
    For i = .Range("A" & .Rows.Count).End(xlUp).Row To 1 Step -1
        Sheets(.Cells(i, 1).Value).Move Before:=Sheets(1)
        Sheets(.Cells(i, 1).Value).Tab.ColorIndex = .Cells(i, 2).Value
      
    Next i
    On Error GoTo 0
  End With
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic

End Sub