Subscript Out Of range when selecting an array I've created - arrays

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)

Related

Extract subarray from jagged array and use as 1d array

I'm trying to reduce redundancy in my macros but I'm struggling with getting an element from a jagged array and using it elsewhere.
The premise is a single workbook with many sheets being split by groups of sheet names into new documents that I can then send to the process owners so they only get their own data.
Previously I was selecting sheet names listed explicitly and pasting to a new document that was named explicitly, but I had to run 10 separate almost identical macros to do that and I have heard of select being a bad choice in many instances as well.
Below is my latest attempt, the first issue is at the printOut line I get a Type Mismatch.
Sub CopyOut()
Dim printOut, groupNames, Group1, groupArray() As Variant
Dim n, j As Long
Dim reNamed, fileName As String
Dim ws As Worksheet
Dim wb1, wb2 As Workbook
groupNames = Array("Group 1", "Group 2", "Group 3", "Group 4") 'other arrays left off for length
Group1 = Array("FA_1A Report", "FA_1A", "FA_2ACS Report", "FA_2ACS", "FA_2BCS Report", "FA_2BCS", "FANUCMED Report", "FANUCMED", "FA_RRTP1 Report", "FA_RRPT1")
groupArray = Array(groupNames, Group1)
For n = 1 To UBound(groupArray)
fileName = "CS Data Sheet" & " " & Format(Date, "mmmyy") & "-" & groupArray(n - n)(n - 1) & ".xlsm" 'concat file name string. this is not just tacked on the end of reName because i use it on it's own later
reNamed = "C:\Users\xx\Desktop\" & fileName 'concat save location string
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Add 'create a new workbook, wb2
wb2.SaveAs fileName:=reNamed, FileFormat:=xlOpenXMLWorkbookMacroEnabled 'save with that name and location
printOut = Join(Application.Index(groupArray, n, 0), ",")
wb1.Sheets(printOut).Copy Before:=Workbooks(fileName).Sheets(1) 'copy the sheets for the group and paste into the newly created document
Next
End Sub
If I nix printOut altogether and put in a specific worksheet name instead it does work for just that one sheet (of course) but I need it to copy multiple to each new document.
I have also tried:
For n = 1 To UBound(groupArray)
...
for j= LBound(groupArray(n)) To UBound(groupArray(n))
wb1.Sheets(groupArray(n)(j)).Copy Before:=Workbooks(fileName).Sheets(1)
next
next
to iterate through the subarray and copy a sheet at a time, but it gives subscript out of range. With this version I tried various methods of making the groupArray(n)(j) value into a string or into a "worksheet" type to set as a variable and use the variable in the sheets().copy, to no avail.
Any idea where I could be going wrong?
thanks so much
EDIT:
I got my above code working by wrapping it in split (was trying to use printOut as an array when it was only a string) and fixing the arguments of Index as below, however the resulting code still needs work, since if a sheet is missing it won't run.
printOut = Split(Join(Application.Index(groupArray(n), 1, 0), ","), ",")
In my experience, if you find yourself hard-coding values like sheet names, group names, and other data directly in your code it tends to become difficult to maintain. Adding more groups, or re-shuffling the sheets in each group becomes problematic. My recommendation is to create a (possibly hidden) worksheet that maps your worksheet names into groups. Then you have a small set of code that operates directly on that.
My example data is set up like this:
Next, in its own code module, I created a few methods to work directly with this group map data. The main idea here is to move the group map data into a memory-based array. While in general I rarely use module-level global variables, I have one in this example to illustrate how to work with the data by only reading it into the array once every time the macro is executed.
(These are Subs and Functions. For my own code, I likely would have created a VBA class to handle the data in an object-oriented way.)
So there is a Private Sub to get the data:
Option Explicit
Private groupData As Variant
Private Sub GetGroupData()
Const GROUP_WS_NAME As String = "GroupMap"
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(GROUP_WS_NAME)
Dim lastRow As Long
Dim lastCol As Long
With ws
'--- how many columns of groups?
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
lastRow = .UsedRange.Find("*", , , , xlByRows, xlPrevious).Row
groupData = .Range("A1").Resize(lastRow, lastCol).Value
End With
End Sub
Now it's easy to figure out how many groups there are:
Public Function NumberOfGroups() As Long
If IsEmpty(groupData) Then GetGroupData
NumberOfGroups = UBound(groupData, 2)
End Function
And how many items in a particular group:
Public Function NumberInGroup(ByVal groupNumber As Long)
If IsEmpty(groupData) Then GetGroupData
'--- count the number of array values that have data
Dim i As Long
For i = LBound(groupData, 1) To UBound(groupData, 1)
If groupData(i, groupNumber) = vbNullString Then
'--- we found the first empty cell in this array, we're done
Exit For
Else
NumberInGroup = NumberInGroup + 1
End If
Next i
'--- subtract one to discount the header value
NumberInGroup = NumberInGroup - 1
End Function
The easiest of all is getting the value of any group:
Public Function GetGroupValue(ByVal groupNumber As Long, _
ByVal groupIndex As Long) As Variant
If IsEmpty(groupData) Then GetGroupData
'--- always add one to the index to account for the header value
GetGroupValue = groupData(groupIndex + 1, groupNumber)
End Function
Notice the check for If IsEmpty(groupData) Then GetGroupData at the beginning of each method. This makes sure the groupData array is always loaded if necessary.
This example gives it a quick test (in a different code module):
Option Explicit
Sub test()
Dim totalGroups As Long
totalGroups = NumberOfGroups()
Dim i As Long
Dim j As Long
For i = 1 To totalGroups
Dim totalInGroup As Long
totalInGroup = NumberInGroup(i)
For j = 1 To totalInGroup
Debug.Print "group " & i & " = " & GetGroupValue(i, j)
Next j
Next i
End Sub
Here's the whole group data code module in a single block:
Option Explicit
Private groupData As Variant
Private Sub GetGroupData()
Const GROUP_WS_NAME As String = "GroupMap"
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(GROUP_WS_NAME)
Dim lastRow As Long
Dim lastCol As Long
With ws
'--- how many columns of groups?
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
lastRow = .UsedRange.Find("*", , , , xlByRows, xlPrevious).Row
groupData = .Range("A1").Resize(lastRow, lastCol).Value
End With
End Sub
Public Function NumberOfGroups() As Long
If IsEmpty(groupData) Then GetGroupData
NumberOfGroups = UBound(groupData, 2)
End Function
Public Function NumberInGroup(ByVal groupNumber As Long)
If IsEmpty(groupData) Then GetGroupData
'--- count the number of array values that have data
Dim i As Long
For i = LBound(groupData, 1) To UBound(groupData, 1)
If groupData(i, groupNumber) = vbNullString Then
'--- we found the first empty cell in this array, we're done
Exit For
Else
NumberInGroup = NumberInGroup + 1
End If
Next i
'--- subtract one to discount the header value
NumberInGroup = NumberInGroup - 1
End Function
Public Function GetGroupValue(ByVal groupNumber As Long, ByVal groupIndex As Long) As Variant
If IsEmpty(groupData) Then GetGroupData
'--- always add one to the index to account for the header value
GetGroupValue = groupData(groupIndex + 1, groupNumber)
End Function
If I got this right, you have one master workbook with n sheets and you want to group some of them, then create a new workbook for each group and paste in its assigned sheets.
I think an approach where you keep a "config" file in your master workbook for setting up groups and sheets, is more suitable rather than editing into code. Example:
The below code will create a file using the names from column A and copy all the sheets defined on their respective row.
Option Explicit
Sub CopyOut()
Dim groupArr() As Variant
Dim wb2 As Workbook
Dim lastRow As Long, lastCol As Long, highestNumOfSheets As Long, i As Long, j As Long, arrColumns As Long
Dim reNamed As String, fileName As String, configSheet As String
Dim removedSheet1 As Boolean
' Modify the sheet name here
configSheet = "config"
' Build an array from sheet defined groups
With ThisWorkbook.Worksheets(configSheet)
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
lastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
If lastCol > highestNumOfSheets Then highestNumOfSheets = lastCol
Next i
groupArr = .Range(.Cells(2, 1), .Cells(lastRow, highestNumOfSheets)).Value2
End With
Application.ScreenUpdating = False
For i = LBound(groupArr) To UBound(groupArr)
fileName = "CS Data Sheet " & Format(Date, "mmmyy") & "-" & groupArr(i, 1) & ".xlsm"
reNamed = Environ("UserProfile") & "\Desktop\" & fileName
removedSheet1 = False ' Reset this on each new workbook created
Set wb2 = Workbooks.Add
' Pick all the sheet names for the current group
For j = 2 To UBound(groupArr, 2)
' Skip empty values from array (if it's the case) and skip missing sheets
If Trim(groupArr(i, j)) <> vbNullString And SheetExists(groupArr(i, j)) Then
ThisWorkbook.Worksheets(groupArr(i, j)).Copy Before:=wb2.Worksheets(1)
' Remove Sheet1 from the new Workbook
If removedSheet1 = False Then
With Application
.DisplayAlerts = False
wb2.Worksheets("Sheet1").Delete
removedSheet1 = True
.DisplayAlerts = True
End With
End If
End If
Next j
' Here you might need an error handler if you think you're going to run the macro multiple times in the same day
' If the file exists already this will throw an error
' A quick lazy way is to add time (including seconds) when you define the file name above
wb2.SaveAs fileName:=reNamed, FileFormat:=xlOpenXMLWorkbookMacroEnabled
wb2.Close
If Not wb2 Is Nothing Then Set wb2 = Nothing
Next i
Application.ScreenUpdating = True
End Sub
Function SheetExists(ByVal sheetName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(sheetName)
On Error GoTo 0
If Not ws Is Nothing Then
SheetExists = True
Set ws = Nothing
End If
End Function
Of course it can be tweaked around, with error handling and other checks (depending on what you want to achieve entirely) but it should give you an alternative view of your code.
EDIT: Added a function to check if sheet exists.

VBA Array to copy multiple CSVs to one template workbook

Disclaimer - I used to write macros a lot, but it's a perishable skill. 5 years takes it toll.
The basic concept is this:
I have a template workbook, with up to 30 tabs, that all have indeterminate rows and columns (i.e. It's not always A7:J30 - one tab might have 3 columns, the next 34 columns. Rows are also indeterminate.).
Currently, someone is copy/pasting 30 separate CSVs into this one templated workbook.
This templated workbook is read by another program to populate data. Row 6 of each template sheet is where the other program looks for headers (i.e. I might copy a CSV's data from A2:G1000, but it would need to paste in A7:G1005 of the template target workbook).
All of the CSVs are stored in the same directory. We can copy/paste a Template workbook into that directory, run a macro, and be done.
What I've done so far:
Sub V1BruteForceCopy()
'
'This code lives in ImportTemplate.XLSM, and is run from the same
'
Workbooks.Open (ThisWorkbook.Path & "\deposits.csv") 'Open deposits.CSV in same directory
Range("A2:G1000000").Copy 'Very inflexible copy job - ugly.
Windows("ImportTemplate.xlsm").Activate 'hate to Activate, but can't get it to work without it.
Sheets("depositbatches").Range("A7").Select 'must call each Sheet in the code, instead of declare variable
ActiveSheet.Paste 'don't like Activate, but Sheets("depositbatches").Range("A7").Paste throws an error.
End Sub 'to add a new CSV and a new Sheet to copy to, I have to copy a whole new block of code and then overwrite Sheets("name") and Workbooks.Open(ThisWorkook.Path & "\name.csv") every time.
Other things I've tried:
Sub rangecopy_001()
Dim ImpTemp As Workbook 'Reserved for ImportTemplate
Dim CSVdeposits As Workbook 'Reserved for deposits.CSV
Dim shDeposits As Worksheet 'Deposits worksheet inside ImportTemplate
Dim lRow As Long 'variable for last row
Dim lCol As Long 'variable for last column
Dim test As Range 'variable for copy/paste range
Set ImpTemp = Workbooks.Open(ThisWorkbook.Path & "\ImportTemplate_CSV.xlsm") 'Open DWImportTemplate
Set CSVdeposits = Workbooks.Open(ThisWorkbook.Path & "\deposits.csv") 'Open deposits.CSV
Set shDeposits = ImpTemp.Sheets("depositbatches") 'Declare that shDeposits is a ImportTemplate sheet
With CSVdeposits 'copy out of deposits.CSV and paste into ImportTemplate deposits sheet
'find last row - makes this dynamic
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'find last column - makes this dynamic
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
test = CSVdeposits.Sheet(1).Range("A2:" & Cells(lRow, lCol)) 'error code 438 - Object doesn't support method
DW.shDeposits.Range("A7") = test
End With
End Sub
This makes the copy range dynamic, but I'm still getting an object error when I try to select the range. I got this method from (Copy from one workbook and paste into another) but it's too simple. Plus, if I want to add another 20 tabs, I have to copy/paste this code block another 20 times and change the variables each time.
I found this (Copy multiple rows from multiple workbooks to one master workbook), but Ron DeBruin's thing won't work because we have to move everything down to Row 6, plus we can't count on the headers of the CSVs working properly.
I like the last answer here (Dynamic range of data to paste into another sheet?) but I can't seem to make it work for a single workbook target from other workbooks.
I want to use an array, or set of arrays to declare my worksheets, but I don't know how to iterate over two arrays at one time that are string-based. I'm thinking something like this, but I'm not done:
Sub ArrayCopyV1()
'
'This code lives in Template.XLSM and is run from the same. Copy this book to the directory you wish to copy from.
'
'
Dim ArraySheets As Variant 'an array with all Sheet names. Should have the same number of args as ArrayCSVs array.
Dim ArrayCSVs As Variant 'an array with all CSV names Should have the same number of args as ArraySheets array.
Dim template As Worksheet 'variable for template worksheet inside
Template workbook
Dim CSV As Workbook 'variable for CSV workbook
Dim i As Integer 'variable i to be used in FOR loop counter
Dim lcol as Integer
Dim lrow as Integer
ArraySheets = Array("depositbatches", "otherSheet1", "OtherSheet2")
ArrayCSVs = Array("\deposits.csv", "other1.csv", "Other2.csv")
For i = LBound(ArraySheets) To UBound(ArraySheets)
Set CSV = Workbooks.Open(ThisWorkbook.Path & ArrayCSVs(i))
Set template = Workbooks.Open(ThisWorkbook.Path & ArraySheets(i))
With CSV 'copy out of deposits.CSV and paste into DWImportTemplate deposits sheet
'find last row - makes this dynamic
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'find last column - makes this dynamic
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
test = CSV.Sheet(1).Range("A2:" & Cells(lRow, lCol))
template.Range("A7") = test
End With
Next i
End Sub
For example:
Sub CopyAll()
Dim rw As Range, wb As Workbook
'read over your file<>sheet table
For Each rw In ThisWorkbook.Sheets("Files").Range("A2:B30").Rows
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & rw.Cells(1).Value) '<< csv file name
With wb.Sheets(1).Range("A1").CurrentRegion
'skip headers (relies on contiguous data)
.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Copy _
ThisWorkbook.Sheets(rw.Cells(2).Value).Range("A7") '<< sheet name to paste into
End With
wb.Close False
Next rw
End Sub

Dynamic Sheets(Array())

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 function calls VBA sub to print array to worksheet

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!

How do I create and pass string array to a sub in Excel VBA?

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.

Resources