VBA Creating a sheet name array from strings

[ch715a]

Hi

This code works great up to the last stage. No matter what I try I get asubscript out of range. A few examples of what I have tried are shown in thecommented out code at the bottom. Ultimately, I want the sheet namesgenerated the code to be converted to a PDF. The sheet name index has alist of all the sheets in the workbook with a TRUE or FALSE in theadjacent column to determine if I should be included in the output.

I work in a reporting team so need this to be applicable to any report using atemplate hence not hard coding the sheet names. The watch window shows thefinal string matches exactly to how I would type it out explicitly and when I do the final lines of code work, so not sure why it doesn’t like this method.

Sub test()
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    
    Dim wsI As Worksheet
    Set wsI = wb.Sheets("SheetNameIndex")
    
    Dim lr As Long
    lr = wsI.Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim rngSht As Range
    Set rngSht = wsI.Range("A2:A" & lr)
    
    wsI.Select
    rngSht.Select
            
    Dim bRPT As Boolean
    Dim strShts() As String
    Dim strAry As String
    
    
    Dim i As Integer
    i = 0
    
    For Each cell In rngSht
        cell.Select
        bRPT = ActiveCell.Offset(0, 1).Value
        Select Case bRPT
            Case True
                i = i + 1
                ReDim Preserve strShts(i)
                strShts(i) = strShts(i) & """" & cell.Value & ""","
                strAry = Join(strShts)
            Case False
        End Select
    Next cell
    
    strAry = Trim(Left(strAry, Len(strAry) - 2))
    strAry = Trim(Right(strAry, Len(strAry) - 1))
'    wb.Sheets(Array(strShts)).ExportAsFixedFormat Type:=xlTypePDF, Filename:="insert filename", OpenAfterPublish:=True
'    wb.Sheets(Array(strAry)).Select
'    wb.Sheets(Array(strAry)).Activate
End Sub

 

[Fluff]

Hi & welcome to MrExcel
Try

Sub test()
   Dim Cell As Range
   Dim wsI As Worksheet
   Dim lr As Long, i As Long
   Dim rngSht As Range
   Dim strAry As Variant

   Set wsI = ActiveWorkbook.Sheets("SheetNameIndex")
   lr = wsI.Cells(Rows.Count, 1).End(xlUp).Row
   Set rngSht = wsI.Range("A2:A" & lr)
   
   ReDim strAry(1 To rngSht.Count)
   For Each Cell In rngSht
       Select Case Cell.Offset(, 1).Value
           Case True
               i = i + 1
               strAry(i) = Cell.Value
       End Select
   Next Cell
   
   Sheets(strAry).Select
End Sub

 

[ch715a]

Thanks fluff, doesn't seem to work though. Still get a subscript of range error, and if I step through it only selects one sheet at a time instead of building up the array like in my original code.

Thanks again for trying to help.

 

[Rick Rothstein]

The best I can tell from your posted code in Message #1 is that you want the list of sheet names assigned to the strAry variable. If I am right, then I think this code will do it for you...

[table="width: 500"]
[tr]
	[td]Sub GetSheetNamesMarkedTrue()
  Dim LastRow As Long, strAry As String, vNum As Variant
  Const Delim As String = ", "
  With Sheets("SheetNameIndex")
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    strAry = Join(Application.Transpose(Evaluate(Replace("IF(B2:B#,A2:A#,"""")", "#", LastRow))), Delim)
  End With
  For Each vNum In Array(121, 13, 5, 3, 3, 2)
    strAry = Replace(strAry, Application.Rept(Delim, vNum), Delim)
  Next
  If Right(strAry, Len(Delim)) = Delim Then strAry = Left(strAry, Len(strAry) - Len(Delim))
  If Left(strAry, Len(Delim)) = Delim Then strAry = Mid(strAry, Len(Delim) + 1)
  
  [B][COLOR="#008000"]' Let's see if strAry contains what it should[/COLOR][/B]
  MsgBox strAry
  
End Sub[/td]
[/tr]
[/table]

 

[ch715a]

Thanks Rick

My original code does what I need in terms of building the array. The next part that I can’t get to work is to then select the worksheets within the array and PDF. This needs to be dynamic as it is going into a report template that can be used for any report.

The variable strAry is giving me what I would expect to see in an array but whether I try convert to PDF, or select / activate the worksheets, I get the subscript out of range error.

Unfortunately I am doing this from work where external filesharing sites are blocked so I can't upload an image, but the bit I am struggling with is literally the last line of code. I've put 3 options that I have tried as comments at the bottom of the code in my original post.

I'll get an image uploaded tonight from home as it may make more sense. Thanks again for trying to help.

 

[Norie]

In Fluff's code try redimming the array once the loop has finished.

Sub test()
   Dim Cell As Range
   Dim wsI As Worksheet
   Dim lr As Long, cnt As Long
   Dim rngSht As Range
   Dim strAry As Variant

   Set wsI = ActiveWorkbook.Sheets("SheetNameIndex")
   lr = wsI.Cells(Rows.Count, 1).End(xlUp).Row
   Set rngSht = wsI.Range("A2:A" & lr)
   
   ReDim strAry(1 To rngSht.Count)
   For Each Cell In rngSht
       Select Case Cell.Offset(, 1).Value
           Case True
               cnt = cnt + 1
               strAry(cnt) = Cell.Value
       End Select
   Next Cell
   
   ReDim Preserve strAry(1 To cnt)

   Sheets(strAry).Select

End Sub

 

[ch715a]

That's done it!! Thanks all for your help, especially Fluff and Norie for their combined solutions that worked.

 

[Fluff]

Glad we could help & thanks for the feedback