worksheet name by code.name list

[KDS14589]

Sub KDS()        'Fluff @MrExcel 9/24

Dim Dic As Object

Dim Ary As Variant

Dim ws As Worksheet



Set Dic = CreateObject("scripting.dictionary")

With ThisWorkbook

For Each ws In .Worksheets

Dic(ws.CodeName) = Empty

Next ws

End With

Ary = SortAZ(Dic)

AA04.Range("AH5").Resize(UBound(Ary) + 1).Value = Application.Transpose(Ary)

End Sub

Function SortAZ(InDic As Object) As Variant

Dim Ary As Variant

Dim i As Long, j As Long

Dim Tmp As Variant



Ary = InDic.keys

For i = 0 To InDic.count - 2

For j = i + 1 To InDic.count - 1

If UCase(Ary(i)) > UCase(Ary(j)) Then

Tmp = Ary(j)

Ary(j) = Ary(i)

Ary(i) = Tmp

End If

Next j

Next i

SortAZ = Ary

End Function

Thanks to Fluff at MrExcel I got a list of the code.names in order for my worksheets in this workbook. This worked great for a few weeks. But now because of a design change for this workbook I need the worksheets name that corresponds to this list instead of code.names. This code is far above my level, so I need help. Instead of a organized list of code.names in AA04.Range("AH5"), I need a list of names in AA04.RANGE("AH5") that corresponds to that list.

 

[DanteAmor]

Change this line:

Dic(ws.CodeName) = Empty

For this:

Dic(ws.Name) = Empty

 

[KDS14589]

Change this line:

Dic(ws.CodeName) = Empty

For this:

Dic(ws.Name) = Empty

I tried this but it produces a list that is alphabetized by NAME but I want to keep the code.name list order but have it give its worksheets name, that last part that's giving me FITS; for example it would list ACC before AAA because the code.name for ACC is listed before the code.name for AAA

 

[DanteAmor]

I already understood. Try:

Sub KDS()        'Fluff @MrExcel 9/24
  Dim Dic As Object
  Dim Ary As Variant, b As Variant
  Dim ws As Worksheet
  Dim i As Long
  
  Set Dic = CreateObject("scripting.dictionary")
  With ThisWorkbook
    For Each ws In .Worksheets
      Dic(ws.CodeName) = ws.Name
    Next ws
  End With
  
  Ary = SortAZ(Dic)
  ReDim b(0 To UBound(Ary), 1 To 1)
  For i = 0 To UBound(Ary)
    b(i, 1) = Dic(Ary(i))
  Next
  
  AA04.Range("AH5").Resize(UBound(b) + 1).Value = b
End Sub

Function SortAZ(InDic As Object) As Variant
  Dim Ary As Variant
  Dim i As Long, j As Long
  Dim Tmp As Variant
  
  Ary = InDic.keys
  For i = 0 To InDic.Count - 2
    For j = i + 1 To InDic.Count - 1
      If UCase(Ary(i)) > UCase(Ary(j)) Then
        Tmp = Ary(j)
        Ary(j) = Ary(i)
        Ary(i) = Tmp
      End If
    Next j
  Next i
  SortAZ = Ary
End Function

 

[DanteAmor]

If you have the AI column available, we can use the sheet to sort the names, try the following:

Sub KDS_3()
  Dim sh As Worksheet
  Dim i As Long
  
  Application.ScreenUpdating = False
  i = 5
  With AA04
    .Range("AH5:AH" & Rows.Count).ClearContents
    For Each sh In Sheets
      .Range("AH" & i).Value = sh.Name
      .Range("AI" & i).Value = sh.CodeName
      i = i + 1
    Next
    .Range("AH5:AI" & .Range("AH" & Rows.Count).End(3).Row).Sort .Range("AI5"), xlAscending, Header:=xlNo
    .Range("AI5:AI" & Rows.Count).ClearContents
  End With
  Application.ScreenUpdating = True
End Sub

 

[KDS14589]

I already understood. Try:

Sub KDS()        'Fluff @MrExcel 9/24
  Dim Dic As Object
  Dim Ary As Variant, b As Variant
  Dim ws As Worksheet
  Dim i As Long
 
  Set Dic = CreateObject("scripting.dictionary")
  With ThisWorkbook
    For Each ws In .Worksheets
      Dic(ws.CodeName) = ws.Name
    Next ws
  End With
 
  Ary = SortAZ(Dic)
  ReDim b(0 To UBound(Ary), 1 To 1)
  For i = 0 To UBound(Ary)
    b(i, 1) = Dic(Ary(i))
  Next
 
  AA04.Range("AH5").Resize(UBound(b) + 1).Value = b
End Sub

Function SortAZ(InDic As Object) As Variant
  Dim Ary As Variant
  Dim i As Long, j As Long
  Dim Tmp As Variant
 
  Ary = InDic.keys
  For i = 0 To InDic.Count - 2
    For j = i + 1 To InDic.Count - 1
      If UCase(Ary(i)) > UCase(Ary(j)) Then
        Tmp = Ary(j)
        Ary(j) = Ary(i)
        Ary(i) = Tmp
      End If
    Next j
  Next i
  SortAZ = Ary
End Function

I used this code and now all my prior changes to other codes work. THANKS a lot. I hope this code is marked as a Solution; I'm having minor Forum problems right now.

 

[DanteAmor]

I used this code and now all my prior changes to other codes work. THANKS a lot.

Im gald to help you, thanks for the feedback.

I hope this code is marked as a Solution; I'm having minor Forum problems right now.

It's not really marked as a solution, but don't worry, when you can come back and mark it as a solution.