Subscript out of range error

[kev_06]

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
Else
ReDim Preserve myArr(1 To wCtr)

Again:
fname = Application.GetSaveAsFilename("", fileFilter:="Excel Files (*.xls), *.xls")

If fname = "False" Then
End
End If

If Dir(fname) <> "" Then
MsgBox ("This filename is already taken. Please enter a different filename.")
GoTo Again
End If

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

--------------------------------------------------------------------------
When I run this code, I get a 'subscript out of range' error on the line

Worksheets(myArr).Copy

Can someone please tell me why?

[Mark Lincoln]

myArr is a String array. Worksheets() expects an Integer argument.

kev_06 wrote:
> 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
> Else
> ReDim Preserve myArr(1 To wCtr)
>
> Again:
> fname = Application.GetSaveAsFilename("", fileFilter:="Excel
> Files (*.xls), *.xls")
>
> If fname = "False" Then
> End
> End If
>
> If Dir(fname) <> "" Then
> MsgBox ("This filename is already taken. Please enter a
> different filename.")
> GoTo Again
> End If
>
> Worksheets(myArr).Copy
> ActiveWorkbook.SaveAs Filename:=fname
> Application.DisplayAlerts = True
> End If
>
> --------------------------------------------------------------------------
> When I run this code, I get a 'subscript out of range' error on the
> line
>
> Worksheets(myArr).Copy
>
> Can someone please tell me why?
>
>
> --
> kev_06
> ------------------------------------------------------------------------
> kev_06's Profile: http://www.excelforum.com/member.php...o&userid=35046
> View this thread: http://www.excelforum.com/showthread...hreadid=548744

[Dave Peterson]

That line expects that you're copying the worksheet name array from the
activeworkbook.

Is that where you loaded the list of worksheet names into the userform's
listbox?

I don't think using the End Statement is a good practice. I used something like
this and it worked ok:

Option Explicit
Private Sub CommandButton1_Click()

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
End Sub
Private Sub UserForm_Initialize()
Dim wks As Worksheet
Me.lstexport.MultiSelect = fmMultiSelectMulti
For Each wks In ActiveWorkbook.Worksheets
Me.lstexport.AddItem CStr(wks.Name)
Next wks
End Sub

=======
If you're picking up the worksheet names from a different workbook (non-active),
then make sure you use that same workbook to copy from:

Worksheets(myArr).Copy
would read more like:
Workbooks("book1.xls").Worksheets(myArr).Copy

As a personal choice, I used do/loop instead of goto.


kev_06 wrote:
>
> 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
> Else
> ReDim Preserve myArr(1 To wCtr)
>
> Again:
> fname = Application.GetSaveAsFilename("", fileFilter:="Excel
> Files (*.xls), *.xls")
>
> If fname = "False" Then
> End
> End If
>
> If Dir(fname) <> "" Then
> MsgBox ("This filename is already taken. Please enter a
> different filename.")
> GoTo Again
> End If
>
> Worksheets(myArr).Copy
> ActiveWorkbook.SaveAs Filename:=fname
> Application.DisplayAlerts = True
> End If
>
> --------------------------------------------------------------------------
> When I run this code, I get a 'subscript out of range' error on the
> line
>
> Worksheets(myArr).Copy
>
> Can someone please tell me why?
>
> --
> kev_06
> ------------------------------------------------------------------------
> kev_06's Profile: http://www.excelforum.com/member.php...o&userid=35046
> View this thread: http://www.excelforum.com/showthread...hreadid=548744

--

Dave Peterson

[Dave Peterson]

Worksheets("Sheet1").select

works????

Mark Lincoln wrote:
>
> myArr is a String array. Worksheets() expects an Integer argument.
>
> kev_06 wrote:
> > 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
> > Else
> > ReDim Preserve myArr(1 To wCtr)
> >
> > Again:
> > fname = Application.GetSaveAsFilename("", fileFilter:="Excel
> > Files (*.xls), *.xls")
> >
> > If fname = "False" Then
> > End
> > End If
> >
> > If Dir(fname) <> "" Then
> > MsgBox ("This filename is already taken. Please enter a
> > different filename.")
> > GoTo Again
> > End If
> >
> > Worksheets(myArr).Copy
> > ActiveWorkbook.SaveAs Filename:=fname
> > Application.DisplayAlerts = True
> > End If
> >
> > --------------------------------------------------------------------------
> > When I run this code, I get a 'subscript out of range' error on the
> > line
> >
> > Worksheets(myArr).Copy
> >
> > Can someone please tell me why?
> >
> >
> > --
> > kev_06
> > ------------------------------------------------------------------------
> > kev_06's Profile: http://www.excelforum.com/member.php...o&userid=35046
> > View this thread: http://www.excelforum.com/showthread...hreadid=548744

--

Dave Peterson