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
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,942
Office Version
  1. 365
Platform
  1. Windows
You would be better off populating all three columns in one go like
VBA Code:
            If InStr(1, ws.Name, Flt, vbTextCompare) = 1 Then
                Sb.Cells(r, NameClm).Resize(, 3).Value = Array(ws.Name, ws.CodeName, ws.Index)
                r = r + 1
            End If
Dlete your final loop & then you can then sort on which ever column you want
 

KDS14589

Board Regular
Joined
Jan 10, 2019
Messages
149
Office Version
  1. 2016
Platform
  1. Windows
You would be better off populating all three columns in one go like
VBA Code:
            If InStr(1, ws.Name, Flt, vbTextCompare) = 1 Then
                Sb.Cells(r, NameClm).Resize(, 3).Value = Array(ws.Name, ws.CodeName, ws.Index)
                r = r + 1
            End If
Dlete your final loop & then you can then sort on which ever column you want
i tried but keep getting code errors
here is my updated code, tell me my goof
VBA Code:
 Sub WorkSheetList()

    Const SwitchBoardName As String = "general_misc"
    Const FilterCell As String = "R5"
    Const OutputRow As Long = 5
    Const NameClm As String = "R"
    Const IndexClm As String = "t"
    Const CodeNameClm As String = "s"


    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
        [R4] = [{"Name"}]
        [s4] = [{"CodeName"}]
        [t4] = [{"Index"}]
    For Each Ws In ThisWorkbook.Worksheets
        If InStr(1, Ws.Name, Flt, vbTextCompare) = 1 Then
            Sb.Cells(r, NameClm).Resize(, 3).Value = Array(Ws.Name, Ws.CodeName, Ws.Index)
            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



End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,942
Office Version
  1. 365
Platform
  1. Windows
You need to remove all of this
VBA Code:
        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
 

KDS14589

Board Regular
Joined
Jan 10, 2019
Messages
149
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

You need to remove all of this
VBA Code:
        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
now my code works and i ran it but my worksheet only show the column headers
 

KDS14589

Board Regular
Joined
Jan 10, 2019
Messages
149
Office Version
  1. 2016
Platform
  1. Windows
You need to remove all of this
VBA Code:
        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
my up-to-date code is
VBA Code:
 Sub WorkSheetList()

    Const SwitchBoardName As String = "general_misc"
    Const FilterCell As String = "R5"
    Const OutputRow As Long = 5
    Const NameClm As String = "R"
    Const IndexClm As String = "t"
    Const CodeNameClm As String = "s"


    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
        [R4] = [{"Name"}]
        [s4] = [{"CodeName"}]
        [t4] = [{"Index"}]
    For Each Ws In ThisWorkbook.Worksheets
        If InStr(1, Ws.Name, Flt, vbTextCompare) = 1 Then
            Sb.Cells(r, NameClm).Resize(, 3).Value = Array(Ws.Name, Ws.CodeName, Ws.Index)
            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



End If

End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,942
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Do you have any sheets that start with whatever is in R5 on the "general_misc" sheet?
 

KDS14589

Board Regular
Joined
Jan 10, 2019
Messages
149
Office Version
  1. 2016
Platform
  1. Windows
Do you have any sheets that start with whatever is in R5 on the "general_misc" sheet?
i did but just now i deleted that worksheet 'general_misc' (old backjup copy i' trying this on first) but now i get error 'subscript out of range'
 

KDS14589

Board Regular
Joined
Jan 10, 2019
Messages
149
Office Version
  1. 2016
Platform
  1. Windows
That's because you've deleted the sheet it's trying to write the data to.

This is getting to complicate for my old, simple mind. I think I'll just keep the newer file 'as-is' and forget about this change.
I appreciate all your help and understanding. You helped me before and I always appreciate it.

Have a safe and good time.

Ken
 

Forum statistics

Threads
1,148,191
Messages
5,745,257
Members
423,941
Latest member
CluelessAboutExcel

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