Subscript out of range error
 

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

Subscript out of range error
 

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

Subscript out of range error
 

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

Subscript out of range error
 

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