build array of sheet names and copy to new workbook

TryingToLearn

Well-known Member
Joined
Sep 10, 2003
Messages
730
Data entry workbook creates sheets with 1st 3 letters of the month then additional info. After data entry is complete, I'm trying to copy the worksheets for that month to a new workbook.

Got as far as creating an array with the correct sheet names but can't seem to get the syntax to copy to new workbook.

Code:
Sub rptCopy()
    Dim Mnth As String
    Dim ws As Worksheet
    Dim myarray() As String
    Dim x, N As Integer
    Dim ShName As Variant
    '------------------
    Mnth = InputBox("Month to report (MMM)  i.e. Feb")
    ReDim Preserve myarray(0)
    For Each ws In ThisWorkbook.Worksheets
        If UCase(Left(ws.Name, 3)) = UCase(Mnth) Then
            ReDim Preserve myarray(UBound(myarray) + 1)
            myarray(UBound(myarray)) = ws.Name
            x = x + 1
        End If
    Next
    If x = 0 Then
        MsgBox "No data found for " & Mnth & " report", vbInformation, "DATA NOT FOUND"
        Exit Sub
    End If
For N = 1 To x
Debug.Print myarray(N)
Next
    Sheets(myarray).Copy
End Sub

Also tried Sheets(Array(myarray)).Copy

either case gives error 9 subscript out of range which leads me to believe the sheet names are not in the correct format.

TIA
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Hello TryingToLearn,

The only problem I can see is that you must give the Sheets() collection a variant CONTAINING an array rather than the array itself. I believe the following should work:

Option Base 1

Sub rptCopy()
Dim Mnth As String
Dim ws As Worksheet
Dim myarray() As String
Dim x, N As Integer
Dim ShName As Variant
'------------------
Mnth = InputBox("Month to report (MMM) i.e. Feb")
ReDim Preserve myarray(0)
For Each ws In ThisWorkbook.Worksheets
If UCase(Left(ws.Name, 3)) = UCase(Mnth) Then
ReDim Preserve myarray(UBound(myarray) + 1)
myarray(UBound(myarray)) = ws.Name
x = x + 1
End If
Next
If x = 0 Then
MsgBox "No data found for " & Mnth & " report", vbInformation, "DATA NOT FOUND"
Exit Sub
End If
For N = 1 To x
Debug.Print myarray(N)
Next
Dim vArray As Variant
vArray = myarray
Sheets(vArray).Copy
End Sub

Note that I added the Option Base 1, which is necessary since your code assumes the array starts with index 1, which is not the default. This statement must appear at the top of the code module.
 
Upvote 0
Damon:

Thanks for the reply. In using the Option Base 1, the first Redim -
ReDim Preserve myarray(0)
errored out till changed to ReDim Preserve myarray(1)

Still come up with error 9 subscript out of range though!!!

copied your code and only made the change mentioned...
 
Upvote 0
Hello, you should be able to use a string array here, e.g.,

<font face=Courier New><SPAN style="color:darkblue">Sub</SPAN> testStrArr()
<SPAN style="color:darkblue">Dim</SPAN> myArr(1 <SPAN style="color:darkblue">To</SPAN> 3) <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN>
myArr(1) = Sheets(1).Name
myArr(2) = Sheets(2).Name
myArr(3) = Sheets(3).Name
Sheets(myArr).Copy
<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">Sub</SPAN></FONT>

I think Redim Preserve is a slow operation, so it's to be avoided in a loop if possible; consequently, I went my own direction with this. Can you get the following to fire Bob?

<font face=Courier New><SPAN style="color:darkblue">Option</SPAN> <SPAN style="color:darkblue">Compare</SPAN> <SPAN style="color:darkblue">Text</SPAN>

<SPAN style="color:darkblue">Sub</SPAN> test()
<SPAN style="color:darkblue">Dim</SPAN> myStr$, ws <SPAN style="color:darkblue">As</SPAN> Worksheet, myMnth$, y <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Long</SPAN>
<SPAN style="color:darkblue">Let</SPAN> myMnth = InputBox("Month to report (MMM)  i.e. Feb")
<SPAN style="color:darkblue">For</SPAN> <SPAN style="color:darkblue">Each</SPAN> ws <SPAN style="color:darkblue">In</SPAN> ThisWorkbook.Worksheets
    <SPAN style="color:darkblue">If</SPAN> Left$(ws.Name, 3) = myMnth <SPAN style="color:darkblue">Then</SPAN> myStr = myStr & ws.Name & vbLf
<SPAN style="color:darkblue">Next</SPAN>
<SPAN style="color:darkblue">Let</SPAN> y = Len(myStr)
<SPAN style="color:darkblue">If</SPAN> <SPAN style="color:darkblue">CBool</SPAN>(y) Then _
    Worksheets(Evaluate("{""" & _
        Application.Substitute(Left$(myStr, y - 1), vbLf, _
        """,""") & """}")).Copy
<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">Sub</SPAN></FONT>
 
Upvote 0
Hi again TryingToLearn,

In looking at your code a bit more I see that it doesn't put anything into the first array element, so the error is due to not finding a sheet with a null string name. A simple solution should be to use the variable x as your array dimensioning:

x = 0
For Each ws In ThisWorkbook.Worksheets
If UCase(Left(ws.Name, 3)) = UCase(Mnth) Then
x = x + 1
ReDim Preserve myarray(x)
myarray(x) = ws.Name
End If
Next

and of course you then no longer need the ReDim Preserve myarray(1)

Damon
 
Upvote 0
Nate:

After adding ucase statements for the sheet names it fired. The reply is appreciated.

Ok, now that it works, I don't have the slightest understanding of why or how with your code. I always look forward to your answers and the asprin that follows :biggrin:

For Each ws In ThisWorkbook.Worksheets
If Left$(ws.Name, 3) = myMnth Then myStr = myStr & ws.Name & vbLf
Next

builds myStr as entry, LF, Entry etc


Let y = Len(myStr)
If CBool(y) Then _

checks to see if there are any entries


Worksheets(Evaluate("{""" & _
Application.Substitute(Left$(myStr, y - 1), vbLf, _
""",""") & """}")).Copy

throws my head into a fit...
 
Upvote 0
TryingToLearn said:
Nate:

After adding ucase statements for the sheet names it fired. The reply is appreciated.
You are welcome. :) Actually if you have 'Option Compare Text' you can drop the case conversion via UCase().
Bob said:
Ok, now that it works, I don't have the slightest understanding of why or how with your code. I always look forward to your answers and the asprin that follows :biggrin:

For Each ws In ThisWorkbook.Worksheets
If Left$(ws.Name, 3) = myMnth Then myStr = myStr & ws.Name & vbLf
Next

builds myStr as entry, LF, Entry etc
Builds a string with a delimeter, the linefeed being the delimeter on concatenation, could be slow...
Bob said:
Let y = Len(myStr)
If CBool(y) Then _

checks to see if there are any entries
Correct. Well, grabs the length, then makes sure it's greater then 0 before proceeding.

Bob said:
Worksheets(Evaluate("{""" & _
Application.Substitute(Left$(myStr, y - 1), vbLf, _
""",""") & """}")).Copy

throws my head into a fit...
The business in between Worksheets().Copy is the XL '97 approach replicating the Split() function, which was introduced in '00 (VB 6 really). It allows one to split a string into an array based on the delimeter. The string is: Left$(myStr, y - 1) and the delimeter is: vbLf.

Hope this helps. :)
 
Upvote 0
Nate:

Thanks for the explaination, I will sort through that last one after the asprin kicks in.

Meantime, the code runs fine when I step through it. Put it on a command button and the headache line errors out with runtime 1004 copy method of sheets class failed.

Tried aiming the button code to a normal module with your code and got same result.

Tried:
Code:
ThisWorkbook.Worksheets(Evaluate("{""" & _
                     Application.Substitute(Left$(myStr, y - 1), vbLf, _
                     """,""") & """}")).Copy

with same result

:confused:
 
Upvote 0
You are welcome. :)

An ActiveX button? The default focus property for this type of button in Excel '97 is problematic both here and in a lot of other cases. :whistle: Set Take Focus On Click to false.
 
Upvote 0
Of course that did the trick. Based on your comments I would assume it to be good habit to automatically set the takefocus to false when setting up a button.

(y)
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,211
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top