Help with subscript out of range error.

R

rick

I need your advice on this one. I've tried everything I can see but nothing
works.
A vba module which controls sheets has the declarations:

Option Explicit
Option Base 1
Public intSheetIndex As Integer
Public SheetName As Variant
Public RPsheets() As Variant, PADsheets() As Variant, RPTsheets() As
Variant, ANLsheets() As Variant

The following sub assigns the sheets to an array:

Sub Assign_Sheets()
Debug.Print "enter assign"
RPsheets = (Array("Summary", "Personnel", "Consultants", "Evaluation",
"Equipment", _
"Travel", "Training", "Res", "Ind", "Don", _
"Loc", "Consolidated", "UserData"))
ReDim Preserve RPsheets(UBound(RPsheets))
PADsheets = (Array("YR1", "YR2", "YR3", "YR4", "YR5", "CRITERIA1",
"CRITERIA2", "CRITERIA3", _
"CRITERIA4", "CRITERIA5", "Comp", "CA", "CA_Sched", _
"consolidation", "xcurrencies"))
ReDim Preserve PADsheets(UBound(PADsheets))
RPTsheets = (Array("FR1", "FR2", "FR3", "FR4", "FR5", "xAdmin"))
ReDim Preserve RPTsheets(UBound(RPTsheets))
ANLsheets = (Array("xProject Info.", "Exp", "Pay", "CFlow", "Analysis", _
"PayRequest", "Supplement", "Xc"))
ReDim Preserve ANLsheets(UBound(ANLsheets))
Debug.Print "exit assign"
End Sub

The following sub is where the problem is. It should protect all sheets in
the arrays:

Sub Protect_Sheets()
Debug.Print "enter protect"
Application.ScreenUpdating = False
Dim i As Integer
For i = 1 To UBound(RPsheets)
ActiveWorkbook.Sheets(RPsheets(i)).Activate
ActiveSheet.Protect DrawingObjects:=True, contents:=True,
Scenarios:=True, AllowInsertingRows:=False
ActiveSheet.EnableSelection = xlUnlockedCells
Next i
Debug.Print "rp sheets protected"
For i = LBound(PADsheets) To UBound(PADsheets)
Debug.Print LBound(PADsheets) & " " & UBound(PADsheets) & " " & PADsheets(i)
& " " & i
ActiveWorkbook.Sheets(PADsheets(i)).Activate
ActiveSheet.Protect DrawingObjects:=True, contents:=True,
Scenarios:=True, AllowInsertingRows:=False
ActiveSheet.EnableSelection = xlUnlockedCells
Next i
Debug.Print "pad sheets protected"
For i = LBound(RPTsheets) To UBound(RPTsheets)
ActiveWorkbook.Sheets(RPTsheets(i)).Activate
ActiveSheet.Protect DrawingObjects:=True, contents:=True,
Scenarios:=True, AllowInsertingRows:=False
ActiveSheet.EnableSelection = xlUnlockedCells
Next i
Debug.Print "rpt sheets protected"
For i = LBound(ANLsheets) To UBound(ANLsheets)
ActiveWorkbook.Sheets(ANLsheets(i)).Activate
ActiveSheet.Protect DrawingObjects:=True, contents:=True,
Scenarios:=True, AllowInsertingRows:=False
ActiveSheet.EnableSelection = xlUnlockedCells
Next i
Debug.Print "exit protect"
Application.ScreenUpdating = True
End Sub

Here is the debug.print log:

enter assign
exit assign
enter protect
rp sheets protected
1 15 YR1 1
1 15 YR2 2
1 15 YR3 3
1 15 YR4 4
1 15 YR5 5
1 15 CRITERIA1 6
1 15 CRITERIA2 7
1 15 CRITERIA3 8
1 15 CRITERIA4 9
1 15 CRITERIA5 10
1 15 Comp 11
1 15 CA 12
1 15 CA_Sched 13

Although the Ubound for the PAD sheets is 15 it blows out at 13. It just so
happens that the RP sheets were 13.

Any advice would be greatly appreciated.

Thanks

.... rick
 
J

Jim Thomlinson

My best guess is that you don't have a sheet named
"consolidation"

Check for spelling mistakes in the sheet name or blank characters padded at
the front or the back of the name.
 
D

Dave Peterson

If the activesheet doesn't have a worksheet by that name, your code will fail.
I'd check the existence first.

And I'd also make sure that those variables are defined before I tried to use
them. Depending on what you've done while debugging, the variables may be
empty.

I'd use something like:

Option Explicit
Option Base 1

Public RPsheets() As Variant
Dim PADsheets() As Variant
Dim RPTsheets() As Variant
Dim ANLsheets() As Variant
Dim VarsAreAssigned As Boolean


Sub Assign_Sheets()

Debug.Print "enter assign"
RPsheets = Array("Summary", "Personnel", "Consultants", _
"Evaluation", "Equipment", _
"Travel", "Training", "Res", "Ind", "Don", _
"Loc", "Consolidated", "UserData")

PADsheets = Array("YR1", "YR2", "YR3", "YR4", "YR5", _
"CRITERIA1", "CRITERIA2", "CRITERIA3", _
"CRITERIA4", "CRITERIA5", "Comp", "CA", "CA_Sched", _
"consolidation", "xcurrencies")

RPTsheets = Array("FR1", "FR2", "FR3", "FR4", "FR5", "xAdmin")

ANLsheets = Array("xProject Info.", "Exp", "Pay", "CFlow", "Analysis", _
"PayRequest", "Supplement", "Xc")

VarsAreAssigned = True

Debug.Print "exit assign"
End Sub
Sub Protect_Sheets()

Debug.Print "enter protect"

Dim i As Long
Dim TestWks As Worksheet

Application.ScreenUpdating = False

If VarsAreAssigned = False Then
Call Assign_Sheets
End If

For i = LBound(RPsheets) To UBound(RPsheets)

Set TestWks = Nothing
On Error Resume Next
Set TestWks = ActiveWorkbook.Worksheets(RPsheets(i))
On Error GoTo 0

If TestWks Is Nothing Then
MsgBox ActiveWorkbook.Name & " doesn't have a sheet named: " _
& RPsheets(i)
Else
With TestWks
.Protect DrawingObjects:=True, contents:=True, _
Scenarios:=True, AllowInsertingRows:=False
.EnableSelection = xlUnlockedCells
End With
End If
Next i
Debug.Print "rp sheets protected"


For i = LBound(PADsheets) To UBound(PADsheets)

Set TestWks = Nothing
On Error Resume Next
Set TestWks = ActiveWorkbook.Worksheets(PADsheets(i))
On Error GoTo 0

If TestWks Is Nothing Then
MsgBox ActiveWorkbook.Name & " doesn't have a sheet named: " _
& PADsheets(i)
Else
With TestWks
.Protect DrawingObjects:=True, contents:=True, _
Scenarios:=True, AllowInsertingRows:=False
.EnableSelection = xlUnlockedCells
End With
End If
Next i
Debug.Print "pad sheets protected"


For i = LBound(RPTsheets) To UBound(RPTsheets)

Set TestWks = Nothing
On Error Resume Next
Set TestWks = ActiveWorkbook.Worksheets(RPTsheets(i))
On Error GoTo 0

If TestWks Is Nothing Then
MsgBox ActiveWorkbook.Name & " doesn't have a sheet named: " _
& RPTsheets(i)
Else
With TestWks
.Protect DrawingObjects:=True, contents:=True, _
Scenarios:=True, AllowInsertingRows:=False
.EnableSelection = xlUnlockedCells
End With
End If
Next i
Debug.Print "rpt sheets protected"


For i = LBound(ANLsheets) To UBound(ANLsheets)

Set TestWks = Nothing
On Error Resume Next
Set TestWks = ActiveWorkbook.Worksheets(ANLsheets(i))
On Error GoTo 0

If TestWks Is Nothing Then
MsgBox ActiveWorkbook.Name & " doesn't have a sheet named: " _
& ANLsheets(i)
Else
With TestWks
.Protect DrawingObjects:=True, contents:=True, _
Scenarios:=True, AllowInsertingRows:=False
.EnableSelection = xlUnlockedCells
End With
End If
Next i
Debug.Print "anl sheets protected"

Application.ScreenUpdating = True
Debug.Print "exit protect"

End Sub

I used msgbox's, but you could use debug.print's if you don't want to inform the
user.
 
R

rick

Thank you both very much for your speedy replies and your insight. By using
your code, Dave, I saw I had a sheet renamed.

....rick
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top