Resizing array to select similar sheet names

[l8sk8r]

Hi all

I have created a script which attempts to grab data from a master worksheet and then select and manipulate 'like' worksheets (at the moment I've just put at msgbox as a place holder).

The thing is I'm having a problem with resizing the array. As a result the first sheets are selected ok, but unfortunately it continues to pickup and add subsequent sheets rather than start afresh.

I have tried entering Dim x(0) into the sequence but then it only picks up the first sheet.

Any help on this would be great. It is truely the last stumbling block in my masterplan.

Cheers

Danny.

Sub SelectSheets()
    Dim strbody, FilenameStr, BarristerEmail, Firstname, Surname, WCRDate, Title, Silk, FindBarr, FindBarr2, Foldername, Shtname As String
    Dim sh, sh2 As Worksheet
    Dim res, x() As Variant
    Dim r1 As Range
    Dim Sourcewb, Destwb As Workbook
    Dim lngIndex As Long
    Set Sourcewb = ThisWorkbook
    Set Destwb = ActiveWorkbook
    
' Start sheet loop 1
For Each sh In Destwb.Worksheets
 ' Find Barrister from source-add in worksheet
    FindBarr = sh.Name
    res = Application.Match(FindBarr, Sourcewb.Worksheets("$DSCMLIST").Range("A:A"), 0)
    If IsError(res) Then
    Shtname = vbNullString
    Title = vbNullString
    Firstname = vbNullString
    Surname = vbNullString
    Silk = vbNullString
    BarristerEmail = vbNullString

' If can't find, skip code and go to next sheet label
GoTo GotoNextsheet:
    Else

' Grab data from worksheet with details stored within the add-in

    Set r1 = Sourcewb.Worksheets("$DSCMLIST").Cells(res, 1)
    Shtname = r1.Offset(0, 0)
    Title = r1.Offset(0, 1)
    Firstname = r1.Offset(0, 2)
    Surname = r1.Offset(0, 3)
    Silk = r1.Offset(0, 4)
    BarristerEmail = r1.Offset(0, 5)

' To select relevant sheets

' Start sheet loop 2
        For Each sh2 In Destwb.Worksheets
        
        ' Sheet select old records conditions for barristers - skips old records and only merges when new records present
            Select Case FindBarr
                Case "CH"
                FindBarr2 = "1CH"
                Case "1CH"
                FindBarr2 = vbNullString
                GoTo GotoNextsheet
                Case "FMP"
                FindBarr2 = "1FP"
                Case "1FP"
                FindBarr2 = vbNullString
                GoTo GotoNextsheet
                Case "NRB"
                FindBarr2 = "1NB"
                Case "1NB"
                FindBarr2 = vbNullString
                GoTo GotoNextsheet
                Case "GS"
                FindBarr2 = "1GS"
                Case "1GS"
                FindBarr2 = vbNullString
                GoTo GotoNextsheet
                Case Else
                FindBarr2 = vbNullString
            End Select
        
            If sh2.Name = FindBarr Or _
                sh2.Name = FindBarr & " (2)" Or _
                sh2.Name = FindBarr & " (3)" Or _
                sh2.Name = FindBarr & " (4)" Or _
                sh2.Name = FindBarr & " (5)" Or _
                sh2.Name = FindBarr & " (6)" Or _
                sh2.Name = FindBarr2 Or _
                sh2.Name = FindBarr2 & " (2)" Or _
                sh2.Name = FindBarr2 & " (3)" Or _
                sh2.Name = FindBarr2 & " (4)" Or _
                sh2.Name = FindBarr2 & " (5)" Or _
                sh2.Name = FindBarr2 & " (6)" Then
                      
                ReDim Preserve x(lngIndex)
                x(lngIndex) = sh2.Name
                lngIndex = lngIndex + 1
            End If
        Next

' End sheet loop 2

' Bind sheets together
    For lngIndex = LBound(x) To UBound(x)
    Sheets(x).Select
    Next
    MsgBox Shtname & "'s - pack selected"
    End If
GotoNextsheet:
        Next sh
        End Sub