Subscript out of range error

[kev_06]

I still get a subscript out of range on the following line:

Worksheets(myArr).Copy

Any ideas?



Dim myArr() As String
Dim wCtr As Long
Dim Ndx As Long
Dim fname As Variant
Dim strname As String
Dim strcheck As String

With Me.lstexport
wCtr = 0
ReDim myArr(1 To .ListCount)
For Ndx = 0 To .ListCount - 1
If .Selected(Ndx) = True Then
wCtr = wCtr + 1
myArr(wCtr) = .List(Ndx)
End If
Next Ndx
End With

If wCtr = 0 Then
'do nothing, nothing selected
Else
ReDim Preserve myArr(1 To wCtr)
Do
fname = Application.GetSaveAsFilename(""
fileFilter:="Excel Files (*.xls), *.xls")

'since fname is a variant, you can compare with the boolea
false
'not the string "False"
If fname = False Then
Exit Sub
End If

If Dir(fname) <> "" Then
MsgBox ("This filename is already taken." & vbLf
"Please enter a different filename.")
Else
Exit Do
End If
Loop

Worksheets(myArr).Copy
ActiveWorkbook.SaveAs Filename:=fname
End I

 

[Guest]

Nope... But put a breakpoint (F9) on the troublesome line, run the macro, and
then check what values you've got in your myArr array, and also make sure
you've got those worksheets available of course (i.e., dump out the worksheet
collection).

Cheers,
/MP

 

[Dave Peterson]

Just the idea from yesterday.

I still get a subscript out of range on the following line:

Worksheets(myArr).Copy

Any ideas?

Dim myArr() As String
Dim wCtr As Long
Dim Ndx As Long
Dim fname As Variant
Dim strname As String
Dim strcheck As String

With Me.lstexport
wCtr = 0
ReDim myArr(1 To .ListCount)
For Ndx = 0 To .ListCount - 1
If .Selected(Ndx) = True Then
wCtr = wCtr + 1
myArr(wCtr) = .List(Ndx)
End If
Next Ndx
End With

If wCtr = 0 Then
'do nothing, nothing selected
Else
ReDim Preserve myArr(1 To wCtr)
Do
fname = Application.GetSaveAsFilename("",
fileFilter:="Excel Files (*.xls), *.xls")

'since fname is a variant, you can compare with the boolean
false
'not the string "False"
If fname = False Then
Exit Sub
End If

If Dir(fname) <> "" Then
MsgBox ("This filename is already taken." & vbLf &
"Please enter a different filename.")
Else
Exit Do
End If
Loop

Worksheets(myArr).Copy
ActiveWorkbook.SaveAs Filename:=fname
End If