Find sheet that contains the highest number using VBA

[newtus]

Hi there,

I have ~1000 workbooks that have sheets labelled 'session1', 'session2', 'session3' etc. The number of 'sessions' (sheets) is variable across workbooks, but for each workbook I want to select the sheet that has the highest session number.

I will then extract data from the last session sheet, close the workbook, open the next workbook and so on.

I'm not sure how to select the sheet that has the highest session number. Any advice would be appreciated.

 

[Trebor76]

Hi newtus,

Though I've written this to work on the current (active) workbook, it can be easily adapted to be used with a workbook you open:

Option Explicit
Sub Macro1()

    Dim lngMyNumber As Long
    Dim wsMySheet As Worksheet
    Dim wsHighestSheet As Worksheet
   
    For Each wsMySheet In ThisWorkbook.Sheets
        If lngMyNumber = 0 Then
            If RetNumerics(CStr(wsMySheet.Name)) > 0 Then
                lngMyNumber = RetNumerics(CStr(wsMySheet.Name))
                Set wsHighestSheet = wsMySheet
            End If
        Else
            If Val(RetNumerics(CStr(wsMySheet.Name))) > lngMyNumber Then
                lngMyNumber = RetNumerics(CStr(wsMySheet.Name))
                Set wsHighestSheet = wsMySheet
            End If
        End If
    Next wsMySheet
    
    If Not wsHighestSheet Is Nothing Then
        MsgBox "The highest sheet tab number is """ & wsHighestSheet.Name & """"
    Else
        MsgBox "There were no numbers found in any of the sheet tabs!!"
    End If

End Sub
Function RetNumerics(ByVal strMyText As String) As Variant 'http://www.mrexcel.com/forum/showthread.php?p=2832147&posted=1#post2832147

    Static objREX As Object
    
    If objREX Is Nothing Then Set objREX = CreateObject("VBScript.RegExp")
    
    With objREX
        .Global = True
        .Pattern = "[0-9]"
        If .test(strMyText) Then
            .Pattern = "[^0-9]"
            RetNumerics = CLng(.Replace(strMyText, vbNullString))
        Else
            RetNumerics = 0 'There are no numbers in the 'strMyText' (i.e. sheet tab name in this example)
        End If
    End With
    
    Set objREX = Nothing
    
End Function

Regards,

Robert

 

[newtus]

Hi Robert, thanks for your help here. That solution mostly works, however I have discovered a large chunk of my files are tripping this up. I didn't know about this when I started.

There is a portion of my files that have additional data stored in them, that also use numbers at the end of the sheet names.

For example:
Session1, Session2, Session3, Exp1, Exp2, Exp3, Exp4.

So I only want to pull out the data from the sheet with highest number that has the prefix 'session'. I tried at a few different modifications of your code to restrict the "search", but have so far been unsuccessful. Any suggestions would be most welcome.

Regards,
Newt

 

[Trebor76]

Hi Newt,

Try this slightly amended procedure:

Option Explicit
Sub Macro1()

    Dim lngMyNumber As Long
    Dim wsMySheet As Worksheet
    Dim wsHighestSheet As Worksheet
   
    For Each wsMySheet In ThisWorkbook.Sheets
        If StrConv(Left(wsMySheet.Name, 7), vbProperCase) = "Session" Then
            If lngMyNumber = 0 Then
                If RetNumerics(CStr(wsMySheet.Name)) > 0 Then
                    lngMyNumber = RetNumerics(CStr(wsMySheet.Name))
                    Set wsHighestSheet = wsMySheet
                End If
            Else
                If Val(RetNumerics(CStr(wsMySheet.Name))) > lngMyNumber Then
                    lngMyNumber = RetNumerics(CStr(wsMySheet.Name))
                    Set wsHighestSheet = wsMySheet
                End If
            End If
        End If
    Next wsMySheet
    
    If Not wsHighestSheet Is Nothing Then
        MsgBox "The highest Session sheet tab number is """ & wsHighestSheet.Name & """"
    Else
        MsgBox "There were either no tabs that started with ""Session"" or they didn't contain any numbers!!"
    End If

End Sub
Function RetNumerics(ByVal strMyText As String) As Variant 'http://www.mrexcel.com/forum/showthread.php?p=2832147&posted=1#post2832147

    Static objREX As Object
    
    If objREX Is Nothing Then Set objREX = CreateObject("VBScript.RegExp")
    
    With objREX
        .Global = True
        .Pattern = "[0-9]"
        If .test(strMyText) Then
            .Pattern = "[^0-9]"
            RetNumerics = CLng(.Replace(strMyText, vbNullString))
        Else
            RetNumerics = 0 'There are no numbers in the 'strMyText' (i.e. sheet tab name in this example)
        End If
    End With
    
    Set objREX = Nothing
    
End Function

Regards,

Robert