Currently I have a user-defined function which runs several routines involving the generation of matrices. To check these matrices have been produced correctly I want to put them on a worksheet. The user defined function works fine and I have added the below into it at the place where I want to find out what is in the array:
Call CheckArray(TestArray)
Where 'TestArray' in the above varies depending on the array I want to look at.
The 'CheckArray' subroutine is as follows:
Sub CheckArray(MyArray As Variant)
MatrixRows = UBound(MyArray, 1)
MatrixCols = UBound(MyArray, 2)
MsgBox MyArray(11, 2)
MsgBox "Matrix size = " & MatrixRows & " rows x " & MatrixCols & " columns"
ActiveWorkbook.Worksheets("Check array").[A1].Resize(MatrixRows, MatrixCols) = MyArray
End Sub
Note that I placed the two MsgBox commands in there to check the sub was called correctly and that it was working, which it is. Moreover, it returned the value in the specific location I requested and it also stated the size of the particular matrix I was looking at, so the data does seem to be getting read correctly - the issue is with subsequently writing that from the new sub.
When I include that final line it does not print my array to the worksheet and it also stops the user-defined function from working correctly. Does anyone know why this isn't working?
Can user-defined functions call subs which print to a worksheet or not? Is there a way to fix this?
To summarise:
As I am using a user-defined function which is entered in a cell in a worksheet I cannot export data to anywhere but that cell. However, I can view the arrays in the Immediate Window.
In MS Excel 2010 the Immediate Window can be found in the VBA editor (Alt+F11) and then click on View -> Immediate Window (Ctrl+G).
To export my array to the Immediate Window I should enter this into my code after the array I want to view:
Call WriteArrayToImmediateWindow(MyArray)
Where 'MyArray' is the name of my array, whatever that is.
This will then call the 'WriteArrayToImmediateWindow' sub, which is:
Sub WriteArrayToImmediateWindow(arrSubA As Variant)
Dim rowString As String
Dim iSubA As Long
Dim jSubA As Long
rowString = ""
Debug.Print
Debug.Print "The array is: "
For iSubA = 1 To UBound(arrSubA, 1)
rowString = arrSubA(iSubA, 1)
For jSubA = 2 To UBound(arrSubA, 2)
rowString = rowString & "," & arrSubA(iSubA, jSubA)
Next jSubA
Debug.Print rowString
Next iSubA
End Sub
Credit for the above goes to User3706920: How to print two dimensional array in Immediate window in VBA?
EDIT:
I decided that viewing the arrays in the Immediate Window wasn't always useful and I needed to view the data comma-separated in Excel. If you want to do the same follow the below instructions:
To export the array to a text file you should enter this into your code after the array you want to view:
Call WriteToFile(MyArray)
Where 'MyArray' is again the name of the array you want to review. The 'WriteToFile macro is as follows:
Sub WriteToFile(arrSubA As Variant)
'To export array to a text file
'Setup
Dim FSO As Object
Dim ofs As Object
Dim Output As Variant
Dim rowString As String
Dim iSubA As Long
Dim jSubA As Long
rowString = ""
'Create file
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Set oFile = FSO.CreateTextFile("C:\Users\" & Environ$("username") & "\Desktop\Array.txt")
oFile.Close
For iSubA = 1 To UBound(arrSubA, 1)
rowString = arrSubA(iSubA, 1)
For jSubA = 2 To UBound(arrSubA, 2)
rowString = rowString & "," & arrSubA(iSubA, jSubA)
Next jSubA
If Len(Dir("C:\Users\" & Environ$("username") & "\Desktop\Array.txt")) > 0 Then
Set ofs = FSO.OpenTextFile("C:\Users\" & Environ$("username") & "\Desktop\Array.txt", 8, True)
End If
ofs.WriteLine rowString
ofs.Close
Next iSubA
End Sub
To quickly view the output array in Excel without any commas I would recommend assigning the below macro to a button:
Sub OpenArrayFile()
'To open array text file in Excel
Workbooks.OpenText Filename:="C:\Users\" & Environ$("username") & "\Desktop\Array.txt", Origin:= _
xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True _
, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
End Sub
Hopefully this is useful to others too!
Related
I think i've got a good start, but I'm having a tough time taking this to the finish line. Could someone help me out?
I have a name column(G) in my spreadsheet. I want to pull the only the last name out of each cell and assign it to an array called name_array.
I know that my If function is working because if I set each name_cell to the LastName variable it substitutes only the lastname in each cell of the column, but I cannot figure out how to assign that to the array.
Here is my code thus far. Can someone please help me out and point out what I'm missing?
Sub create_namear()
Dim name_array() As Variant
Dim name_range As Range
Dim name_cell As Range
Dim n As Long
Set name_range = ActiveSheet.Range("G2:G" & Range("G" & Rows.Count).End(xlUp).Row)
ReDim name_array(name_range.Cells.Count)
For Each name_cell In name_range.Cells
Dim Lastname As String
If InStr(name_cell, " ") > 0 Then
Lastname = Split(name_cell, " ")(1)
End If
name_array(n) = lastname.value
n = n + 1
Next name_cell
Debug.Print name_array(1)
End Sub
Name Column
Here is another way to achieve what you want without looping. I have commented the code so you should not have a problem understanding it.
BASIC LOGIC
To get the part after SPACE, you can use the formula =IFERROR(MID(G2,SEARCH(" ",G2,1),LEN(G2)-SEARCH(" ",G2,1)+1),"")
Now applying the formula in the entire range and getting the value using INDEX(FORMULA). You can find the explanation of this method in Convert an entire range to uppercase without looping through all the cells
CODE
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Dim lRow As Long, i As Long
Dim FinalAr As Variant
'~~> Set this to the relevant sheet
Set ws = Sheet1
With ws
'~~> Find last row in col G
lRow = .Range("G" & .Rows.Count).End(xlUp).Row
'~~> Set your range
Set rng = .Range("G2:G" & lRow)
'~~> Get all the last names from the range and store them
'~~> in an array in 1 go!
FinalAr = Evaluate("index(IFERROR(MID(" & _
rng.Address & _
",SEARCH("" ""," & _
rng.Address & _
",1),LEN(" & _
rng.Address & _
")-SEARCH("" ""," & _
rng.Address & _
",1)+1),""""),)")
End With
'~~> Check the output
For i = LBound(FinalAr) To UBound(FinalAr)
Debug.Print ">"; FinalAr(i, 1)
Next i
End Sub
IN ACTION
ALTERNATIVE METHODS
Use Text To columns and then store the output in an array
Use Flash Fill to get the last names and then store the output in an array. One drawback of this method is that the names which do not have last name, it will show first name instead of a blank.
Sub create_namear()
Dim name_array() As Variant
Dim name_range As Range
Dim name_cell As Range
Dim n As Long
Set name_range = ActiveSheet.Range("G2:G" & Range("G" & Rows.Count).End(xlUp).Row)
ReDim name_array(0 to name_range.Cells.Count-1) '### 0-based array...
For Each name_cell In name_range.Cells
If InStr(name_cell, " ") > 0 Then
name_array(n) = Split(name_cell, " ")(1) 'simplify...
End If
n = n + 1
Next name_cell
Debug.Print name_array(1)
End Sub
Solution using Filter() (values with missing lastnames are excluded):
Sub ExtractLastNames()
Dim arr, name_array, i
arr = WorksheetFunction.Transpose(Range("G2:G" & Cells(Rows.Count, "G").End(xlUp).Row)) 'first, get the horizontal one-dimentional array from cells
name_array = Filter(arr, " ", True) 'second, filter out one-word and empty elements
For i = LBound(name_array) To UBound(name_array)
name_array(i) = Split(name_array(i))(1) 'third, replace name_array values with extracted lastnames
Next
Range("H2").Resize(UBound(name_array) + 1) = WorksheetFunction.Transpose(name_array) ' output
End Sub
Last Names to Array
The following will consider the substring after the last occurring space as the last name.
Option Explicit
Sub create_namear()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim nRange As Range
Set nRange = ws.Range("G2:G" & ws.Range("G" & ws.Rows.Count).End(xlUp).Row)
Dim rCount As Long: rCount = nRange.Rows.Count
Dim nArray() As String: ReDim nArray(0 To rCount - 1)
Dim nCell As Range
Dim n As Long
Dim nmLen As Long
Dim LastSpacePosition As Long
Dim nmString As String
Dim LastName As String
For Each nCell In nRange.Cells
nmString = CStr(nCell.Value)
If InStr(1, nmString, " ") > 0 Then
LastSpacePosition = InStrRev(nCell.Value, " ")
nmLen = Len(nmString)
If LastSpacePosition < nmLen Then
LastName = Right(nmString, nmLen - LastSpacePosition)
nArray(n) = LastName
n = n + 1
End If
End If
Next nCell
If n = 0 Then Exit Sub
If n < rCount Then
ReDim Preserve nArray(0 To n - 1)
End If
Debug.Print "[" & LBound(nArray) & "," & UBound(nArray) & "]" _
& vbLf & Join(nArray, vbLf)
End Sub
Extension on Siddharth' s formula evaluation
These additions to Siddharth's valid code can be helpful, if there are less than 2 data rows in order to avoid
an unwanted evaluation of the title row 1:1 (in case of no data at all, see section 1.b) - This can be prevented by correcting a resulting row number lRow of only 1 to the actual data row start of 2.
Error 9 Subscript out of range (in case of a single element; see section 3.b) - Note that this requires to transform a 1-dim result to a 2-dim results array by means of a adequately dimensioned tmp array.
Furthermore I simplified the formula building to avoid repeated rng.Address insertions just to show another way of doing it (see section 2.).
Sub GetLastName()
'0. Set this to the relevant sheet
Dim ws As Worksheet: Set ws = Sheet1
With ws
'1. Define data range
'1. a) Find last row in col G
Dim lRow As Long
lRow = .Range("G" & .Rows.count).End(xlUp).Row
'1. b) Provide for empty data set ' << Added to avoid title row evaluation
If lRow = 1 Then lRow = 2
'1. c) Set your range
Dim rng As Range: Set rng = .Range("G2:G" & lRow)
'2. Define formula string parts ' << Modified for better readibility
Dim FormulaParts()
FormulaParts = Array("INDEX(IFERROR(MID(", _
",SEARCH("" "",", _
",1),LEN(", _
")-SEARCH("" "",", _
",1)+1),""""),)")
'3. Assign last names to 2-dim array results
'3. a) Get all the last names from the range and store them
Dim results
results = Evaluate(Join(FormulaParts, rng.Address))
End With
'3.b) Provide for single results '<< Added to avoid Error 9 Subscript o/Rng
If UBound(results) = 1 Then '<< Force single element into 2-dim array
Dim tmp(1 To 1, 1 To 1)
tmp(1, 1) = results(1)
results = tmp
End If
'h) Display in VB Editor's immediate window
Dim i As Long
For i = LBound(results) To UBound(results)
Debug.Print ">"; results(i, 1)
Next i
'i) Write last names to target '<< Added to demonstrate writing back
ws.Range("H2").Resize(UBound(results), 1) = results
End Sub
I'm trying to create a single PDF file containing a sheet for each tab which I have listed from cell J2 in my Control sheet but I keep getting a Subscript Out Of Range error.
When I record the action I see that it creates an array of sheet names which it then selects to export, so I have a For loop which goes through the list and creates an array which adds to itself until it reaches the end of the list - the aim being to create one long string which I then select as an array.
All appears to be good (the variable PDFArray displays a string of the tab names in what appears to be the correct format) but when I get to the line 'Worksheets(Array(PDFarray)).Select' then I get the error. I've made sure the sheet names contain no undesirable characters or spaces but still no joy. Any help would be very much appreciated. Thank you
Sub B_PDFs()
Dim PDFarray As String, PDFName as String, sht As String
Sheets("Control").Select
PLFile = ActiveWorkbook.Name
PDFLoc = Application.ActiveWorkbook.Path & "\"
PDFName = Range("A20")
PDFSheetCount = Range("J1").Offset(Rows.Count - 1, 0).End(xlUp).Row
'Loop through column J and create a string with each tab name to be exported
For x = 2 To PDFSheetCount Step 1
If x = PDFSheetCount Then
sht = """ " & "" & Cells(x, 10) & """ "
Else
sht = """" & "" & Cells(x, 10) & """" & ", "
End If
PDFarray = PDFarray & sht
Next x
'Create PDF from the array above
Worksheets(Array(PDFarray)).Select - this is where I get the error Subscript Out Of Range
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PFDLoc & PDFName, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False,
OpenAfterPublish:=False
Workbooks(PLFile).Activate
End Sub
I don't understand why MS makes NOT requiring variable declaration the default. Select Tools/Options/Editor and check Require Variable Declaration. This will place Option Explicit at the start of any new module. To correct this module, enter it manually at the beginning.
Doing so would have enabled you to find and correct a typo in your code.
You should also be avoiding Select, Selection and Activate. They rarely serve any purpose at all, and can cause multiple problems because they lull into avoiding explicit declarations of which workbook, worksheet, etc. you need. See How to avoid using Select in Excel VBA
However in using the ExportAsFixedFormat method to export selected worksheets, it seems Selection and ActiveSheet are required for it to work.
Array(str_variable) returns an array with a single entry that contains the entire string variable. It does not interpret the string variable so as to split it into separate elements.
So, rewriting your code somewhat (I will leave it to you to clean up the PDF document):
Option Explicit
Sub B_PDFs()
Dim PDFarray As Variant, PDFName As String, PLFile As String, PDFLoc As String
Dim wsControl As Worksheet
Dim WB As Workbook
'Consider wheter you want to use ThisWorkbook or a specific workbook
Set WB = ThisWorkbook
With WB
Set wsControl = .Worksheets("Control")
PLFile = .Name
PDFLoc = .Path & "\"
End With
With wsControl
PDFName = .Range("A20")
'create PDFarray
'This will be a 1-based 2D array starting at J1
'If you need to start at J2, alter the initial cell
PDFarray = .Range(.Cells(1, 10), .Cells(.Rows.Count, 10).End(xlUp))
End With
'convert to a 1D array
PDFarray = WorksheetFunction.Transpose(PDFarray)
'Note the use of `Select` and `ActiveSheet` when using this `ExportAsFixedFormat` method
Worksheets(PDFarray).Select
'Create PDF from the array above
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFLoc & PDFName, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
What #RonRosenfeld has suggested is correct about select and selection. The expression you are building is string whereas, Excel expects it to be real array.
So in principle an approach like below shall work for you which will create an array for processing and can be used as you want to utilise.
Dim shtNames As Variant
Dim pdfArray
shtNames = Range("J2:J" & Range("J1").Offset(Rows.Count - 1, 0).End(xlUp).Row).Value
pdfArray = Application.Transpose(shtNames)
Scenario: I have a workbook with multiple worksheets. I am trying to use a function (called within a sub) to export arrays with data from certain worksheets. The arrays are created before the function with the content from the worksheet with:
If ws.Name = "AA" Then
expaa = ws.UsedRange.Value
End if
where expaa is previously defined as variant.
The function I am using apparently finishes running, but the output on the new file saved is weird: instead of having one row of headers, the first row is split into 2 for some reason (all the others remain the same).
This is the function I am using:
Function Exporter(arr As Variant, y As String, OutPath As String) As Variant
Dim lrow As Long, lColumn As Long
Dim w2 As Workbook
Dim d As Date
Workbooks.Add
Set w2 = ActiveWorkbook
w2.Worksheets(1).Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
Application.DisplayAlerts = False
w2.SaveAs Filename:=OutPath & "\" & y, FileFormat:=6
Application.DisplayAlerts = True
w2.Close True
End Function
Which I call from the main sub with:
If aa_name <> "" Then
Exporter expaa , "aa_OK", wbpath
End If
where aa_name is the name of the file used to retrieve the path.
Obs: The wbpath variable is a string with the path of my main workbook (therefore the new file is saved at the same location).
Question: What may be causing the first row of my output to be split? How can that be fixed?
Obs2: I know this can be done with copy procedure, and looping through the array and so on. I even got it to work with other methods. This post is only to understand what I am doing wrong with the current code.
Obs3: Regarding the data that is going to be passed: it is a matrix of days, identifiers and data, ex:
Item1 Item2 Item3
01/01/2000 1 1 2
02/01/2000 1 2 1
03/01/2000 2 2 2
with around 2000 rows and 3000 columns.
UPDATE: After retesting the code multiple times, It appears that the data of the first row only gets split when the file is save as csv (when the array is pasted, the output is normal). Any idea on what may be the cause for that?
I know this is old but here is my solution for the googlers. This accepts an array and creates a CSV at a path you define. Its probably not perfect but it has worked so far for me.
Option Explicit
Option Private Module
Public Function SaveTextToFile(ByVal targetarray As Variant, ByVal filepath As String) As Boolean
On Error GoTo CouldNotMakeFile
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim fileStream As TextStream
' Here the actual file is created and opened for write access
Set fileStream = fso.CreateTextFile(filepath)
' Write something to the file
Dim Row As Long, Col As Long
For Row = LBound(targetarray, 1) To UBound(targetarray, 1)
For Col = LBound(targetarray, 2) To UBound(targetarray, 2)
fileStream.Write StringCompliance(targetarray(Row, Col)) & IIf(Col = UBound(targetarray, 2), "", ",")
Next Col
fileStream.WriteBlankLines 1
Next Row
' Close it, so it is not locked anymore
fileStream.Close
' Here is another great method of the FileSystemObject that checks if a file exists
If fso.FileExists(filepath) Then
SaveTextToFile = True
End If
CouldNotMakeFile:
End Function
Private Function StringCompliance(ByVal InputString As String) As String
Dim CurrentString As String
CurrentString = InputString
'Test if string has qoutes
If InStr(CurrentString, Chr$(34)) > 0 Then
CurrentString = Chr$(34) & Replace(CurrentString, Chr$(34), Chr$(34) & Chr$(34)) & Chr$(34)
StringCompliance = True
Else
'Tets if string has commas or line breaks
If InStr(CurrentString, ",") > 0 Or InStr(CurrentString, vbLf) > 0 Then
CurrentString = Chr$(34) & CurrentString & Chr$(34)
Else
StringCompliance = False
End If
End If
StringCompliance = CurrentString
End Function
I want to select a array of sheets using the Sheets(Array()) method.
The sheets I want to select are named in the cells of my workheet Printlist.
The sheetnames are listed form column D to K.
Not all cells are filled so if I use the folowing function it errors on the rows with blank cells. How can I avoid this error:
This is what the sheet looks like:
And this is the code
Sub PDF_maken()
Dim ws As Worksheet
Dim LR As Long
Dim r As Range
Dim Mypath As String
Dim strarray As String
Set ws = ActiveWorkbook.Worksheets("Printlijst")
LR = ws.Cells(Rows.Count, 1).End(xlUp).Row
For Each r In ws.Range("B20:B20").Cells
If Not IsEmpty("B" & r.Row) Then
Mypath = ws.Range("B" & r.Row).Text
colCheck = 4
Do Until Cells(r.Row, colCheck) = ""
strarray = strarray & IIf(colCheck > 4, ",") & """" & Cells(r.Row, colCheck).Value & """"
colCheck = colCheck + 1
Loop
ActiveWorkbook.Sheets(strarray).Select
ActiveWorkbook.SelectedSheets.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Mypath & ws.Range("C" & r.Row).Text & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
Next r
End Sub
You can use a regular array rather than the Array() function to create the array. Then you can loop through the cells that contains sheet names and only add them if they're not blank. Here's an example.
Sub PDF_maken()
Dim ws As Worksheet
Dim lLastRow As Long
Dim rMap As Range
Dim sPath As String
Dim aSheets() As String
Dim lShCnt As Long
Dim rSh As Range
Set ws = ActiveWorkbook.Worksheets("Printlist")
lLastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For Each rMap In ws.Range("B2:B" & lLastRow).Cells
'Make sure there's a path
If Not IsEmpty(rMap.Value) Then
sPath = ws.Range("B" & rMap.Row).Text
're-dimension an array to hold all the sheet names
ReDim aSheets(1 To Application.WorksheetFunction.CountA(rMap.Offset(, 2).Resize(1, 8)))
'reset the counter
lShCnt = 0
'loop through all the cells that might have a sheet name
'and add them to the array
For Each rSh In rMap.Offset(, 2).Resize(1, 8).Cells
If Not IsEmpty(rSh.Value) Then
lShCnt = lShCnt + 1
aSheets(lShCnt) = rSh.Text
End If
Next rSh
ActiveWorkbook.Sheets(aSheets).Select
ActiveSheet.ExportAsFixedFormat xlTypePDF, sPath & rMap.Offset(0, 1).Text & ".pdf"
End If
Next rMap
ws.Select
End Sub
If you get Error 9: Subscript Out of Range there are three things to check:
The first one is that you spelled a sheet name wrong. Make sure there are no spaces or other funny business that makes it look like you have a good sheet name and you don't.
Next, make sure you qualify all of your references back to the workbook level. Depending on where your code is, unqualified references can point to different places. Don't ever use Sheets(). Always use ThisWorkbook.Sheets() or some other workbook reference. That will make sure you're not trying to access a sheet in a workbook that you didn't intend to.
Finally, you can get that error if you pass numbers to Sheets because your sheet names are numbers. Or rather they look like numbers, but they're really text. sheets(array(1234,4567)).select is different than sheets(array("1234","4567")).select. You have to pass strings to Sheets or you'll get that error. Kind of. You can pass numbers, but it will Select the sheets based on their index numbers rather than their names. That's why you have to be extra careful when your sheet names look like numbers.
Do a similar loop,
something like
colCheck=4
do until cells(r.row,colCheck)=""
strArray=strarray & iif(colCheck>4,",","") & cells(r.row,colCheck).value
colCheck=colCheck+1
loop
then you'll get something like a,b,c I've not tested this, so may need some tweaking. I'll revisit in a moment.
VBA arrays are new to me and it seems like there are multiple ways to create string arrays.
I believe I need to create a dynamic array
But I can't find any examples how to pass dynamic arrays to a subroutine
I know how many items there need to be in the array by the count of the User range (so maybe I don't need a dynamic array??). I'm having trouble passing the array through to another Subroutine.
The thought process is as follows:
Iterate through a list of user names
Create a sheet for each
Save each user name in an array as I iterate through
In another Subroutine, select all the sheets I created and save as a PDF
Below is my code. I'm getting Run-time error 9 - Subscript out of range (Referring to the array object)
I appreciate any help! Thank you!
Sub CreateAllDashboards(StartDate As Date, EndDate As Date)
'Used to iterate through the list of users and call the Sub to create Dashboards
Dim UserNameRangeStart As Range
Set UserNameRangeStart = Range("UserName")
Dim SheetNames() As String
'Cyle through users
For i = 1 To GetUserNameRange().CounT
'Some code
ReDim Preserve SheetNames(i)
SheetNames(i) = UserNameRangeStart.Offset(i, 0).Value
Next i
Call CreatePDF(EndDate, SheetNames) 'Also tried SheetNames()
End Sub
Sub CreatePDF(FileDate As Date, ByRef SheetNames As Variant)
Dim FilePath As String, FileName As String
FilePath = Application.ActiveWorkbook.Path
FileName = "Production Dashboards - " & Format(FileDate, "mmddyy") & ".pdf"
ThisWorkbook.Sheets(SheetNames).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
FileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
The array parameter is not a problem it is passed correctly to method CreatePDF(...). The parameter type can be changed to SheetNames() As String but SheetNames As Variant works as well.
Then the Run-time error 9 - Subscript out of range is raised here ThisWorkbook.Sheets(SheetNames).Select because the array SheetNames contains invalid sheet name, which is the very first item. This item is an empty string and empty string is not valid as a sheet name.
In the For Next loop index starts with value 1 but the array starts with 0. So the very first item of the array SheetNames remains untouched and is finally an empty string. To solve it set the lower bound in ReDim explicitly to 1. HTH
(Note: if you omit lower bound then Option Base is used and if no Option Base is specified then 0 is used.)
'Cyle through users
For i = 1 To GetUserNameRange().Count
'Some code
ReDim Preserve SheetNames(1 To i)
SheetNames(i) = UserNameRangeStart.Offset(i, 0).value
Next i
I would change this:
Sub CreatePDF(FileDate As Date, ByRef SheetNames As Variant)
To this:
Sub CreatePDF(FileDate As Date, SheetNames() As String)
But your problem is at this line:
ThisWorkbook.Sheets(SheetNames).Select
Edited from dee's comment:
You can put an array of sheet names in .Sheets() but without empty rows. So in your sub "CreateAllDashboards" do this:
ReDim Preserve SheetNames(i - 1)
SheetNames(i - 1) = UserNameRangeStart.Offset(i, 0).Value
and you could read that about arrays in VBA.
I've tested the following using a single sheet workbook with a range named Users and another named FileDate. It does what you asked.
The reason for the Run-time error 9 - Subscript out of range error is that you have to reference the array element. ThisWorkbook.Sheets(SheetNames).Select will throw an error but ThisWorkbook.Sheets(SheetNames(x)).Select won't (as long as x is initialised and within the bounds of the array)
Sub PopulateArray()
Dim user As Range
Dim SheetNames As Variant
ReDim SheetNames(1 To 1) 'Initialise the array
For Each user In [Users]
ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
With Worksheets(Worksheets.Count)
.Name = user.Value2
.[A1] = user.Value2 'you can't print a blank sheet!
End With
SheetNames(UBound(SheetNames)) = user.Value2
ReDim Preserve SheetNames(1 To UBound(SheetNames) + 1)
Next user
ReDim Preserve SheetNames(1 To UBound(SheetNames) - 1) 'Delete the last element
Call CreatePDF([FileDate], SheetNames)
End Sub
Sub CreatePDF(FileDate As Date, ByRef SheetNames As Variant)
Dim FilePath As String, FileName As String
Dim x As Long
FilePath = Application.ActiveWorkbook.Path & "\" 'Note backslash added to path.
FileName = "Amtec Production Dashboards - " & Format(FileDate, "mmddyy")
For x = 1 To UBound(SheetNames)
ThisWorkbook.Sheets(SheetNames(x)).ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
FileName & SheetNames(x) & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
Next x
End Sub
The above demonstrates how to parse an array to another sub as requested but you could integrate the CreatePDF code into the calling sub fairly easily too.