Searching for a way in VBA to group worksheets by selection

[AR_Razorback]

I have an extensive workbook (more than 50 worksheets) that are identical. I am trying to find a way to group just the specific worksheets that need to be updated simultaneously. My vision for this was to have a form control button that would bring up a window listing all of the NON-Hidden worksheets and I would then select (CheckBox) the sheets I want to group and when clicking OK it would activate the first sheet selected in the group, make the changes/edits and then ungroup. Below is what I have started, just having a difficult time with the grouping aspect. Kind of long, but I was trying to modify the below code that originally would allow me to just select a specific worksheet (Option Button), and would take me to a specific range. Thanks

Sub SheetgrpSelector()

Const ColItems As Long = 20
Const LetterWidth As Long = 10
Const HeightRowz As Long = 18
Const SheetID As String = "__SheetSelection"

Dim i%, TopPos%, iSet%, optCols%, intLetters%, optMaxChars%, optLeft%
Dim wsDlg As DialogSheet, objOpt As CheckBox, optCaption$, objSheet As Object
optCaption = "": i = 0

Application.ScreenUpdating = False



On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(<wbr>SheetID).Delete
Application.DisplayAlerts = True
Err.Clear

Set wsDlg = ActiveWorkbook.DialogSheets.<wbr>Add
With wsDlg
.Name = SheetID
.Visible = xlSheetHidden
iSet = 0: optCols = 0: optMaxChars = 0: optLeft = 78: TopPos = 40

For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
i = i + 1

If i Mod ColItems = 1 Then
optCols = optCols + 1
TopPos = 40
optLeft = optLeft + (optMaxChars * LetterWidth)
optMaxChars = 0
End If

intLetters = Len(objSheet.Name)
If intLetters > optMaxChars Then optMaxChars = intLetters
iSet = iSet + 1
.CheckBoxes.Add optLeft, TopPos, intLetters * LetterWidth, 16.5
.CheckBoxes(iSet).Text = objSheet.Name
TopPos = TopPos + 13

End If
Next objSheet

If i > 0 Then

.Buttons.Left = optLeft + (optMaxChars * LetterWidth) + 24

With .DialogFrame
.Height = Application.Max(68, WorksheetFunction.Min(iSet, ColItems) * HeightRowz + 10)
.Width = optLeft + (optMaxChars * LetterWidth) + 24
.Caption = "Select Task Order to enter monthly update"
End With

.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront
Application.ScreenUpdating = True

If .Show = True Then
For Each objOpt In wsDlg.CheckBoxes
If objOpt.Value = xlOn Then
optCaption = objOpt.Caption
Exit For
End If
Next objOpt
End If

If optCaption = "" Then
MsgBox "You did not select a WorkSheet.", 48, "Cannot continue"
Exit Sub
Else

MsgBox "You selected WorkSheet ''" & optCaption & "''." & vbCrLf & "Click OK to go there.", 64, "FYI:"
Sheets(optCaption).Select
Sheets(optCaption).Activate
ActiveSheet.Range("AF69:AF72")<wbr>.Select



End If

End If

Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True

End With


End Sub

 

[AR_Razorback]

I am still a beginner with VBA, but I have decided to abandon modifying the above code for the purpose I intended. It works amazingly to select a specific (1) worksheet. I wanted to modify it to select multiple worksheets in an array because I really liked how the dialog sheet displayed, but I decided to use a Userform with a multiselect listbox.

Private Sub UserForm_Initialize()

  Dim ws As Worksheet

  For Each ws In ThisWorkbook.Worksheets
      ListBox1.AddItem (ws.Name)

  Next ws
End Sub

Private Sub CommandButton1_Click()

  Dim i As Integer
  Dim sht As String
  Dim arrSheets()
  Dim idx As Long
  Dim cnt As Long

      For idx = 0 To ListBox1.ListCount -1 
           If ListBox1.Selected(idx) Then
               ReDim Preserve arrSheets(cnt)
               arrSheets(cnt) = ListBox1.List(idx)
               cnt = cnt +1
           End If
        Next idx

           If cnt > 0 Then
               Sheets(arrSheets).Select
               ActiveSheet.Range("AF69:AF72").Select
'Selects the worksheets and then takes you to the area on the first sheet where the updates are being made
           End If

Unload Userform2

End Sub

This works exactly how I need it to, just wondering if anyone has tips to get the worksheets in the list box to display in columns, I have roughly 76 sheets. I have tried several methods best I could do was change the column width, but my list stays in one column.