Public Function funcSortKeysByLengthDesc(dctList As Object) As Object Dim arrTemp() As String Dim curKey As Variant Dim itX As Integer Dim itY As Integer 'Only sort if more than one item in the dict If dctList.Count > 1 Then 'Populate the array ReDim arrTemp(dctList.Count - 1) itX = 0 For Each curKey In dctList arrTemp(itX) = curKey itX = itX + 1 Next 'Do the sort in the array For itX = 0 To (dctList.Count - 2) For itY = (itX + 1) To (dctList.Count - 1) If Len(arrTemp(itX)) < Len(arrTemp(itY)) Then curKey = arrTemp(itY) arrTemp(itY) = arrTemp(itX) arrTemp(itX) = curKey End If Next Next 'Create the new dictionary Set funcSortKeysByLengthDesc = CreateObject("Scripting.Dictionary") For itX = 0 To (dctList.Count - 1) funcSortKeysByLengthDesc.Add arrTemp(itX), dctList(arrTemp(itX)) Next Else Set funcSortKeysByLengthDesc = dctList End If
End Function