View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
BOBODD BOBODD is offline
external usenet poster
 
Posts: 26
Default Subscript out of Range Error

Got it. I need to use ReDim Preserve FullSheetNames(i), not ReDim Preserve
FullSheetNames(1 To i)

"BOBODD" wrote:

Thanks Jim, but it doesn't seem to have made a difference. Here is the entire
sub, in case something else is causing the error. This should create an array
containing all of the appropriate sheet names which is then passed to a Copy
command.

Private Sub CmdOK_Click()
Dim MyFile As Variant
Dim MyFileName As String
Dim wks As Worksheet
Dim MyFileFilter As String
Dim SheetNames As String
Dim FullSheetNames() As String
Dim Ans As Integer, i As Integer
PubCol = 4
Ans = MsgBox("Do you want to save a copy of these forms?", vbYesNo)
If Ans = vbYes Then
i = 1
MyFileName = Sheets("schedule").Range("C6") 'Uses Client name as
default
file name
MyFileFilter = "Excel Files (*.xls),*.xls"
MyFile = Application.GetSaveAsFilename(MyFileName, MyFileFilter)
If MyFile < False Then
For Each wks In ThisWorkbook.Worksheets
Select Case wks.Name
Case "Sheet1"
SheetNames = ""
Case "Prices"
SheetNames = ""
Case "word output"
SheetNames = ""
Case "DD Auth"
If DDPymt = True Then
SheetNames = wks.Name
Else
SheetNames = ""
End If
Case "Auto Pymt Form"
If DDPymt = False Then
SheetNames = wks.Name
Else
SheetNames = ""
End If
Case Else
SheetNames = wks.Name
End Select
If SheetNames < "" And i 1 Then
ReDim Preserve FullSheetNames(1 To i)
FullSheetNames(i) = SheetNames
i = i + 1
ElseIf SheetNames < "" And i = 1 Then
ReDim FullSheetNames(1)
FullSheetNames(1) = SheetNames
i = i + 1
End If
Next
End if
End Sub

"Jim Thomlinson" wrote:

Remove the As String from the Redim.

ReDim Preserve FullSheetNames(1 To i)
--
HTH...

Jim Thomlinson