build array of sheet names and copy to new workbook

TryingToLearn

Well-known Member
Joined
Sep 10, 2003
Messages
723
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
 

Some videos you may like

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

Damon Ostrander

MrExcel MVP
Joined
Feb 17, 2002
Messages
4,239
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.
 

TryingToLearn

Well-known Member
Joined
Sep 10, 2003
Messages
723
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...
 

NateO

Legend
Joined
Feb 17, 2002
Messages
9,700
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>
 

Damon Ostrander

MrExcel MVP
Joined
Feb 17, 2002
Messages
4,239

ADVERTISEMENT

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
 

TryingToLearn

Well-known Member
Joined
Sep 10, 2003
Messages
723
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...
 

NateO

Legend
Joined
Feb 17, 2002
Messages
9,700

ADVERTISEMENT

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. :)
 

TryingToLearn

Well-known Member
Joined
Sep 10, 2003
Messages
723
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:
 

NateO

Legend
Joined
Feb 17, 2002
Messages
9,700
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.
 

TryingToLearn

Well-known Member
Joined
Sep 10, 2003
Messages
723
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)
 

Watch MrExcel Video

Forum statistics

Threads
1,122,962
Messages
5,599,065
Members
414,281
Latest member
Engjamal2021

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
Top