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
