Adding Sort To Current Code

[Pacman52]

Hi all, I have the following sub that populates a WS called 'Contents' with all the sheets in the workbook. Whilst testing with the end user they asked if the sheets listed could be sorted from oldest to newest.

The current and subsequent sheets in the workbook will all be in the format of '01-01-24 - Name1' (any new sheet names are created dependant on what userform is selected will always be in that format)

Could anyone let me know if its possible to adapt this code below to include the sort function?

Many thanks Paul

Sub Contents()

    Const showHidden As Boolean = False
    Dim wsList As Worksheet
    Dim sheetIndex As Integer
    Dim rowNumber As Integer
    Dim colNumber As Integer
    Dim sheetCounter As Integer
   
    On Error Resume Next

    Set wsList = ThisWorkbook.Sheets("Contents")
    On Error GoTo 0
    
    If wsList Is Nothing Then
        Set wsList = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(2))
        wsList.Name = "Contents"
   
        Rows("2").RowHeight = 25
        Rows("3").RowHeight = 5
        Rows("5:500").RowHeight = 18
        Columns("B").ColumnWidth = 70

        ActiveWindow.DisplayGridlines = False
        ActiveWindow.DisplayHeadings = False
        
    Else
   
        wsList.Cells.Clear
       
    End If
    
    With wsList.Range("B2")
   
        .Value = "Contents"
        .Font.Bold = True
        .Font.Color = RGB(21, 96, 130)
        .Font.Name = "Calibri"
        .Font.Size = 20
        .Font.Underline = True
        .HorizontalAlignment = xlCenter
   
    End With
   
    With wsList.Range("B4")
   
        .Value = "Click once on the link below of the event you want to view."
        .Font.Bold = True
        .Font.Color = RGB(21, 96, 130)
        .Font.Name = "Calibri"
        .Font.Size = 12
        .Font.Italic = True
        .HorizontalAlignment = xlCenter

    End With
   
        rowNumber = 6
        colNumber = 2
 
 For sheetIndex = 1 To ThisWorkbook.Sheets.Count
       
        With ThisWorkbook.Sheets(sheetIndex)

            If .Name <> "Contents" And _
                (showHidden Or .Visible = xlSheetVisible) Then
                
                    wsList.Hyperlinks.Add _
                        Anchor:=wsList.Cells(rowNumber, colNumber), _
                        Address:="", _
                        SubAddress:="'" & _
                            ThisWorkbook.Sheets(sheetIndex).Name & _
                            "'!A1", _
                        TextToDisplay:=ThisWorkbook.Sheets(sheetIndex).Name
                    
                    rowNumber = rowNumber + 1
                    
            End If
       
        End With
       
    Next sheetIndex
   
End Sub

 

[Pacman52]

That is because your values are not dates (since they have text in them), so they will sort alphabetically.
Any change you could change the date portion of your string to a format of yyyy-mm-dd?
If so, then sorting alphabetically will also sort in date order, so it would sort the way you want then.

Thanks Joe, I did think that was the case re it not seeing it as a date.

I need to re-evaluate the sheet naming structure and think of a workaround for this, I will try changing the format of the date part to 'yyyy' first but I have a feeling that the end user, my wife !! wont be happy, as she was quiet specific when she asked for the list to be sorted in the first place.

I will post back the results though.

Thanks again Paul

 

[Joe4]

You are welcome.

Thanks Joe, I did think that was the case re it not seeing it as a date.

Yes, in order for Excel to recognize it as a date, there must ONLY be a date (and possibly time) in that entry.
Once you add text to the entry, it can never be a date, and will always be treated as Text.

 

[Micron]

You could probably parse the date portion, convert it to a date and then do something with it. That something might be an invisible helper cell with US date format that you use to sort on, or whatever tickles your fancy. Since you already have a loop I'd probably put a call to a separate function where this is done because the code to create a date from a portion of your string will be a bit convoluted. This could only work if the date portion had a consistent format.

 

[Micron]

On second thought, creating a number and not a date from the date portion of the string is probably what you'd need because of differences in regional settings. This would create a double data type from your string - double in case it turns out that you have values that are the same date. You'd then need to add a decimal portion; just not sure where that would come from. Perhaps system time.

Public Function StringToNumber(strIn As String) As Double
Dim yrPart As String, mthPart As String, dayPart As String

yrPart = Mid(strIn, InStrRev(strIn, "-") + 1, 4)
mthPart = Mid(strIn, InStr(strIn, "-") + 1, 2)
dayPart = Left(strIn, 2)
StringToNumber = DateSerial(yrPart, mthPart, dayPart)
'Debug.Print StringToNumber

End Function

Call from primary sub: stringtonumber("15-11-2024 Whatever text")
where the part in parentheses might be a range reference - can't recall what part of the original code looks like for that part.

 

[Pacman52]

Thanks Micron and sorry for not replying sooner (the email notification went to my junk box).

I have managed to extract the date portion of the sheet name using the sub below. Initially that failed as the Contents sheet was protected so added the calls to sort that bit out.

I also needed to move the columns over by 1 so that the original Col B (the full sheet name list) is now in Col C

The ExtractDate sub then takes the first 10 characters of a sheet name in the list and writes that to the corresponding cell in Col B and this as as far as I've got with it due to time last night.

I did manged to very quickly test the sort sub but this time on Col B and that did work although its only currently coded to sort Col B so the sheet names remained in the same order so I just hopefully need to update the Sort sub below to include Col C and fingers crossed it should work hopefully !!

Sub ExtractDate()
Dim lastRow As Long
Dim i As Long

    Call UnprotectSheet

        lastRow = Cells(Rows.Count, "C").End(xlUp).Row

    For i = 7 To lastRow

        Cells(i, "B").Value = Left(Cells(i, "C").Value, 10)
    
    Next i

    Call ProtectSheet

End Sub

Sub SortColB()
Dim ws As Worksheet
Dim lastRow As Long

    Set ws = ThisWorkbook.Worksheets("Contents")
    
        lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    With ws.sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("B7:B" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("B7:B" & lastRow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    
    End With


End Sub