ascending [index] order of worksheets

KDS14589

Board Regular
Joined
Jan 10, 2019
Messages
149
Office Version
  1. 2016
Platform
  1. Windows
I Have this code that produces a list of the worksheets [name] cells B, [codename] cells C and [index] cells D. But the list is unorganized. I wish the list to be ascending 1,2,3 etc. according to [index] cells D


VBA Code:
 Dim nm As Name, n As Long, y As Range, z As Worksheet
    
    Application.ScreenUpdating = False
    
    Set z = ActiveSheet
    n = 5
    With z
        
    Const SwitchBoardName As String = "general_misc"
    Const FilterCell As String = "B5"
    Const OutputRow As Long = 5
    Const NameClm As String = "B"
    Const IndexClm As String = "D"
    Const CodeNameClm As String = "C"
    
    
    Dim Sb As Worksheet
    Dim Flt As String
    Dim TabNames() As String
    Dim r As Long
    Dim ws As Worksheet
    Dim Rng As Range
    
        Set Sb = ThisWorkbook.Worksheets(SwitchBoardName)
        Flt = Sb.Range(FilterCell).Cells(1).Value
        ReDim TabNames(ThisWorkbook.Worksheets.Count)
    
        r = OutputRow
            [B4] = [{"Name"}]
            [C4] = [{"CodeName"}]
            [D4] = [{"Index"}]
            
        For Each ws In ThisWorkbook.Worksheets
            If InStr(1, ws.Name, Flt, vbTextCompare) = 1 Then
                Sb.Cells(r, NameClm).Value = ws.Name
                r = r + 1
            End If
            
        Next ws
    
        If r Then
            Set Rng = Sb.Range(Sb.Cells(OutputRow, NameClm), Sb.Cells(r - 1, NameClm))
            With Sb.Sort
                With .SortFields
                    .Clear
                    .Add Key:=Rng.Cells(1), _
                              SortOn:=xlSortOnValues, _
                              Order:=xlAscending, _
                              DataOption:=xlSortTextAsNumbers
                End With
    
                .SetRange Rng
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
    
            With Rng
                For r = 1 To .Cells.Count
                    Set ws = ThisWorkbook.Worksheets(.Cells(r).Value)
                    Sb.Cells(.Cells(r).Row, IndexClm).Value = ws.Index
                    Sb.Cells(.Cells(r).Row, CodeNameClm).Value = ws.CodeName
                  
                Next r
            End With
        End If
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,943
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.

Forum statistics

Threads
1,148,194
Messages
5,745,276
Members
423,942
Latest member
excelhelp1423

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top