I have a document with 500 WorkSheets and trying to print all the ones where G1 = "Print" as a Single document.

My steps are to create an array and store the matching worksheet names. Next is to select that worksheets from the array and print them.

Sub Help()

 Dim MyArray() As Variant
 Dim I As Long
 Dim MyArray_Count As Integer
   MyArray_Count = 0

 Worksheet_Count = ActiveWorkbook.Worksheets.Count

 For I = 1 To Worksheet_Count
   If Worksheets(I).Range("G1").Value = "Print" Then
       MyArray_Count = MyArray_Count   1
       MyArray(MyArray_Count) = ActiveWorkbook.Worksheets(I).Name ' 'Having error here
   End If

 Next I

 Worksheets(MyArray).Select 'having error here

 End Sub

CodePudding user response：

There are many ways to do this, but the important piece you are missing is Redim Preserve.

I changed a few things to keep it simple. I tried to stick closely to your design. As you can see, you also have to plan for what happens when none of them meet the condition.

Sub Help()
  Dim ws As Worksheet
  Dim MyArray() As String
  ReDim MyArray(0)

  For Each ws In ActiveWorkbook.Worksheets
    If ws.Range("G1").Value = "Print" Then
      If Len(MyArray(0)) > 0 Then ReDim Preserve MyArray(UBound(MyArray)   1)
      MyArray(UBound(MyArray)) = ws.Name
    End If
  Next

  If Len(MyArray(0)) > 0 Then
     ActiveWorkbook.Worksheets(MyArray).Select
  Else
     MsgBox "none found"
  End If
 
End Sub

_{Note: Keep in mind that "Print" in your cell is not the same thing as "print" or "PRINT"}

Here is a better If statement to address that:

If UCase$(Trim$(ws.Range("G1").Value)) = "PRINT" Then

CodePudding user response：

Dictionary vs Array

Dictionary

• You don't know how many worksheets will be added, therefore using the dictionary presents a more suitable (easier) solution. Also, using a For Each...Next loop makes it kind of more readable and emphasizes that the number of worksheets is not relevant.

Option Explicit

Sub HelpDictionary()

    Dim wb As Workbook: Set wb = ActiveWorkbook
    ' If you're dealing with the workbook containing this code, instead use:
    'Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Dim cString As String
    
    ' Add the worksheet names to the dictionary.
    For Each ws In wb.Worksheets
        cString = CStr(ws.Range("G1").Value)
        If StrComp(cString, "Print", vbTextCompare) = 0 Then ' 'PRINT = print'
            dict(ws.Name) = Empty ' only interested in the keys
        End If
    Next ws
    
    ' Check if any worksheet name was added.
    If dict.Count = 0 Then ' no worksheet name added
        MsgBox "No worksheets to select.", vbExclamation
        Exit Sub
    'Else ' at least one worksheet name was added
    End If
    
    wb.Worksheets(dict.Keys).Select

    MsgBox "The following worksheets are selected: " _
        & vbLf & Join(dict.Keys, vbLf), vbInformation
    
End Sub

Array

• This is also a valid solution. Compare it with the dictionary solution to see how it is more complicated.

Sub HelpArray()

    Dim wb As Workbook: Set wb = ActiveWorkbook
    ' If you're dealing with the workbook containing this code, instead use:
    'Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim aCount As Long: aCount = wb.Worksheets.Count
    
    Dim MyArray() As String: ReDim MyArray(1 To aCount) ' to fit 'a'll names
    
    Dim cString As String
    Dim a As Long ' 'a'll worksheets
    Dim p As Long ' worksheets to 'p'rint
    
    ' Add the worksheet names to the array.
    For a = 1 To aCount
        cString = CStr(Worksheets(a).Range("G1").Value)
        If StrComp(cString, "Print", vbTextCompare) = 0 Then ' 'PRINT = print'
            p = p   1
            MyArray(p) = wb.Worksheets(a).Name
        End If
    Next a
    
    ' Check if any worksheet name was added.
    If p = 0 Then ' no worksheet name added
        MsgBox "No worksheets to select.", vbExclamation
        Exit Sub
    'Else ' at least one worksheet name was added
    End If
    
    ' Resize if not all worksheet names.
    If p < aCount Then ' not all worksheet names added
        ReDim Preserve MyArray(1 To p)
    'Else ' all worksheet names added
    End If
    
    wb.Worksheets(MyArray).Select

    MsgBox "The following worksheets are selected: " _
        & vbLf & Join(MyArray, vbLf), vbInformation
    
End Sub