Subscript out of range

N

noname

Hi,

I m trying to call a procedure say Proc1 in my code, which writes code
lines to a new worksheet for the events Activate and Change clubbed
together....
----------------------------------------------------
sub MYCODE
....
....
For each cell in CellRange
sheets.add after:=sheets(1)
call Proc1
next cell
....
....
End Sub
----------------------------------------------------
Sub Proc1
Dim StartLine As Double
With
ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(ActiveSheet.Name).CodeName).CodeModule
StartLine = .CreateEventProc("Activate", "Worksheet") + 1
.InsertLines StartLine + 0, "Dim r, c, AvailH, er, total, totemp
As Integer"
.InsertLines StartLine + 1, "Dim r1 As Range"
.InsertLines StartLine + 2, "Dim comstr As String"
.InsertLines StartLine + 3, "dt = Date"
.InsertLines StartLine + 4, "ActiveSheet.Unprotect"
.InsertLines StartLine + 5, "Range(Cells(1, ""B""), Cells(1,
Cells(1, ""B"").End(xlToRight).Column)).Select"
.InsertLines StartLine + 6, "Set f = Selection.Find(What:=dt,
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)"
.InsertLines StartLine + 7, "If Not f Is Nothing Then"
.InsertLines StartLine + 8, " c = f.Column"
.InsertLines StartLine + 9, "Else"
.InsertLines StartLine + 10, " c = 2"
.InsertLines StartLine + 11, "End If"
............
.............
..............
End Sub

****************** Now, heres the puzzling part *******************
Now, if the VBE editor window is open, the code gets pasted properly
to the activesheet, BUT, if the VBE editor is not open, then its
results in an error "Run Time error - 9. Subscript out of range".

When i click Debug, In the VBE code window its shows the 2nd line
above highlighted in yellow.
i.e.
With
ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(ActiveSheet.Name).CodeName).CodeModule

I m not sure, but i think this kind of error usually occurs due to
some sheets.count overflow or something...

Can anyone shed some light on this n how to rectify it......

I dont want to keep the VBE editor code window open due to security
reasons.

Regards,
 
B

Bernie Deitrick

Change

sheets.add after:=sheets(1)
call Proc1

to
Dim mySht As Worksheet

Set mySht = Sheets.Add(after:=Sheets(1))
Proc1 mySht


And change the top of Proc1 to:

Sub Proc1(Sht As Worksheet)
Dim StartLine As Double
Application.DisplayAlerts = False
With ThisWorkbook.VBProject.VBComponents(Sht.Name).CodeModule
StartLine = .CreateEventProc("Activate", "Worksheet") + 1
.....

HTH,
Bernie
MS Excel MVP
 
N

noname

Hi,

Can anybody help me with this as i m still getting error 9 even after
doin the above changes....

Rgds,
 
N

noname

Hi all,

i have a sheet in which there are a range of Dept names.

i m selecting the name n looping thru the names ...using each name i m
creating a new worksheet and then calling an event procedure macro to
insert worksheet change code in the activesheet....

1] If the VBE Code window is not open, Excel gives an error "Error
9.....Subscript out of range"

2] If the VBE Window is open, Excel crashes!!

3] If there are multiple Dept names, Excel crashes!! Maybe Excel
crashing on multiple names the event module gets called multiple times
bcos of the loop....

Can anyone find how to rectify this cos i cant keep the VBE code
window open for security reasons....if someone wants to see the file,
i can send them a sample....pls let me know asap.

Main Module:
------------------
Sub SkillAdd()
........
........

For Each cell In Range("SkNm")
..........
.........
..........

'....Make a new Skill Sheet n populate with data .........
Dim Wk As Worksheet
Set Wk = Sheets.Add(after:=Sheets("BaseSheet"))
Wk.Name = skill
EventCode Wk
Set Wk = Nothing

Cells(1, 1).Value = skill
Cells(1, 1).Interior.ColorIndex = 6
Cells(1, 1).Font.Bold = True
Cells(1, 1).Select
Call Borders(selection)
..........
...........
.........

end sub




Event Code i m calling everytime:
-----------------------------------------------
Sub EventCode(Wk As Worksheet)
Wk.Activate
Dim StartLine As Double
Application.DisplayAlerts = False
With
ThisWorkbook.VBProject.VBComponents(Worksheets(Wk.Name).CodeName).CodeModule
StartLine = .CreateEventProc("Change", "Worksheet") + 1
.InsertLines StartLine, "Dim Rngx As Range"
.InsertLines StartLine + 1, "rowx = Target.Row"
.InsertLines StartLine + 2, "colx = 7"
.InsertLines StartLine + 3, "Set Rngx = Range(Cells(rowx, 3),
Cells(rowx, colx))"
.InsertLines StartLine + 4, "If
WorksheetFunction.CountIf(Rngx, ""x"") > 1 Or
WorksheetFunction.CountIf(Rngx, ""X"") > 1 Then"
.InsertLines StartLine + 5, " MsgBox ""You can only rate
once!"""
.InsertLines StartLine + 6, " Target.ClearContents"
.InsertLines StartLine + 7, " Exit Sub"
.InsertLines StartLine + 8, "ElseIf
WorksheetFunction.CountIf(Rngx, ""x"") = 1 Or
WorksheetFunction.CountIf(Rngx, ""X"") = 1 Then"
.InsertLines StartLine + 9, " Cells(rowx, 1).Font.ColorIndex
= 5"
.InsertLines StartLine + 10, " Cells(rowx,
2).Font.ColorIndex = 5"
.InsertLines StartLine + 11, "ElseIf
WorksheetFunction.CountIf(Rngx, ""x"") = 0 Or
WorksheetFunction.CountIf(Rngx, ""X"") = 0 Then"
.InsertLines StartLine + 12, " Cells(rowx,
1).Font.ColorIndex = 3"
.InsertLines StartLine + 13, " Cells(rowx,
2).Font.ColorIndex = 3"
.InsertLines StartLine + 14, "End If"
.DeleteLines .CountOfLines - 1
End With
Application.DisplayAlerts = True
End Sub



Regards

:(
 
B

Bernie Deitrick

The easiest way around this is to use the Workbook's sheet change event. The code below will do the
same thing as having your code insert a new sheet change event into every sheet. Copy the code into
the ThisWorkbook's codemodule.

HTH,
Bernie
MS Excel MVP

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Rngx As Range
rowx = Target.Row
colx = 7
Set Rngx = Sh.Range(Sh.Cells(rowx, 3), Sh.Cells(rowx, colx))
If WorksheetFunction.CountIf(Rngx, "x") > 1 Or _
WorksheetFunction.CountIf(Rngx, "X") > 1 Then
MsgBox "You can only rate once! """
Target.ClearContents
Exit Sub
ElseIf WorksheetFunction.CountIf(Rngx, "x") = 1 Or _
WorksheetFunction.CountIf(Rngx, "X") = 1 Then
Sh.Cells(rowx, 1).Font.ColorIndex = 5
Sh.Cells(rowx, 2).Font.ColorIndex = 5
ElseIf WorksheetFunction.CountIf(Rngx, "x") = 0 Or _
WorksheetFunction.CountIf(Rngx, "X") = 0 Then
Sh.Cells(rowx, 1).Font.ColorIndex = 3
Sh.Cells(rowx, 2).Font.ColorIndex = 3
End If

End Sub


noname said:
Hi all,

i have a sheet in which there are a range of Dept names.

i m selecting the name n looping thru the names ...using each name i m
creating a new worksheet and then calling an event procedure macro to
insert worksheet change code in the activesheet....

1] If the VBE Code window is not open, Excel gives an error "Error
9.....Subscript out of range"

2] If the VBE Window is open, Excel crashes!!

3] If there are multiple Dept names, Excel crashes!! Maybe Excel
crashing on multiple names the event module gets called multiple times
bcos of the loop....

Can anyone find how to rectify this cos i cant keep the VBE code
window open for security reasons....if someone wants to see the file,
i can send them a sample....pls let me know asap.

Main Module:
------------------
Sub SkillAdd()
.......
.......

For Each cell In Range("SkNm")
.........
........
.........

'....Make a new Skill Sheet n populate with data .........
Dim Wk As Worksheet
Set Wk = Sheets.Add(after:=Sheets("BaseSheet"))
Wk.Name = skill
EventCode Wk
Set Wk = Nothing

Cells(1, 1).Value = skill
Cells(1, 1).Interior.ColorIndex = 6
Cells(1, 1).Font.Bold = True
Cells(1, 1).Select
Call Borders(selection)
.........
..........
........

end sub




Event Code i m calling everytime:
-----------------------------------------------
Sub EventCode(Wk As Worksheet)
Wk.Activate
Dim StartLine As Double
Application.DisplayAlerts = False
With
ThisWorkbook.VBProject.VBComponents(Worksheets(Wk.Name).CodeName).CodeModule
StartLine = .CreateEventProc("Change", "Worksheet") + 1
.InsertLines StartLine, "Dim Rngx As Range"
.InsertLines StartLine + 1, "rowx = Target.Row"
.InsertLines StartLine + 2, "colx = 7"
.InsertLines StartLine + 3, "Set Rngx = Range(Cells(rowx, 3),
Cells(rowx, colx))"
.InsertLines StartLine + 4, "If
WorksheetFunction.CountIf(Rngx, ""x"") > 1 Or
WorksheetFunction.CountIf(Rngx, ""X"") > 1 Then"
.InsertLines StartLine + 5, " MsgBox ""You can only rate
once!"""
.InsertLines StartLine + 6, " Target.ClearContents"
.InsertLines StartLine + 7, " Exit Sub"
.InsertLines StartLine + 8, "ElseIf
WorksheetFunction.CountIf(Rngx, ""x"") = 1 Or
WorksheetFunction.CountIf(Rngx, ""X"") = 1 Then"
.InsertLines StartLine + 9, " Cells(rowx, 1).Font.ColorIndex
= 5"
.InsertLines StartLine + 10, " Cells(rowx,
2).Font.ColorIndex = 5"
.InsertLines StartLine + 11, "ElseIf
WorksheetFunction.CountIf(Rngx, ""x"") = 0 Or
WorksheetFunction.CountIf(Rngx, ""X"") = 0 Then"
.InsertLines StartLine + 12, " Cells(rowx,
1).Font.ColorIndex = 3"
.InsertLines StartLine + 13, " Cells(rowx,
2).Font.ColorIndex = 3"
.InsertLines StartLine + 14, "End If"
.DeleteLines .CountOfLines - 1
End With
Application.DisplayAlerts = True
End Sub



Regards

:(






Hi,

Can anybody help me with this as i m still getting error 9 even after
doin the above changes....

Rgds,
Click to expand...
Click to expand...
 
N

noname

Excellent Bernie :)

You solved my problem pending for so many days!

However, i still want to know what could be the problem with the
previous code. It should work ideally...is it because of the looping
or codename not identified during runtime?

If you want i can send u the copy of the original workbook so that you
can help me identify this problem..cos i use a lot of worksheet event
code module writing and this problem is a regular issue which i have
not been able to understand or capture....

And just to bring to you notice, this code will run on all sheets in
the workbook. This would be a problem because i have two initial
sheets "Main" which is a front-end where buttons n other initial data
is entered, and another sheet "BaseSheet" which stores values for
reference. So, is there a workaround for the same using the code which
u suggested to skip the 1st two sheets from the Workbook_Sheet_Change
code..

Looking forward to a learning experience from you regarding the same..


Cheers to you mate :D





The easiest way around this is to use the Workbook's sheet change event. The code below will do the
same thing as having your code insert a new sheet change event into every sheet. Copy the code into
the ThisWorkbook's codemodule.

HTH,
Bernie
MS Excel MVP

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Rngx As Range
rowx = Target.Row
colx = 7
Set Rngx = Sh.Range(Sh.Cells(rowx, 3), Sh.Cells(rowx, colx))
If WorksheetFunction.CountIf(Rngx, "x") > 1 Or _
WorksheetFunction.CountIf(Rngx, "X") > 1 Then
MsgBox "You can only rate once! """
Target.ClearContents
Exit Sub
ElseIf WorksheetFunction.CountIf(Rngx, "x") = 1 Or _
WorksheetFunction.CountIf(Rngx, "X") = 1 Then
Sh.Cells(rowx, 1).Font.ColorIndex = 5
Sh.Cells(rowx, 2).Font.ColorIndex = 5
ElseIf WorksheetFunction.CountIf(Rngx, "x") = 0 Or _
WorksheetFunction.CountIf(Rngx, "X") = 0 Then
Sh.Cells(rowx, 1).Font.ColorIndex = 3
Sh.Cells(rowx, 2).Font.ColorIndex = 3
End If

End Sub


Hi all,
Click to expand...
i have a sheet in which there are a range of Dept names.
Click to expand...
i m selecting the name n looping thru the names ...using each name i m
creating a new worksheet and then calling an event procedure macro to
insert worksheet change code in the activesheet....
Click to expand...
1] If the VBE Code window is not open, Excel gives an error "Error
9.....Subscript out of range"
Click to expand...
2] If the VBE Window is open, Excel crashes!!
Click to expand...
3] If there are multiple Dept names, Excel crashes!! Maybe Excel
crashing on multiple names the event module gets called multiple times
bcos of the loop....
Click to expand...
Can anyone find how to rectify this cos i cant keep the VBE code
window open for security reasons....if someone wants to see the file,
i can send them a sample....pls let me know asap.
Click to expand...
Main Module:
Click to expand...
For Each cell In Range("SkNm")
.........
........
.........
Click to expand...
'....Make a new Skill Sheet n populate with data .........
Dim Wk As Worksheet
Set Wk = Sheets.Add(after:=Sheets("BaseSheet"))
Wk.Name = skill
EventCode Wk
Set Wk = Nothing
Click to expand...
Cells(1, 1).Value = skill
Cells(1, 1).Interior.ColorIndex = 6
Cells(1, 1).Font.Bold = True
Cells(1, 1).Select
Call Borders(selection)
.........
..........
........
Click to expand...
end sub
Click to expand...
Event Code i m calling everytime:
-----------------------------------------------
Sub EventCode(Wk As Worksheet)
Wk.Activate
Dim StartLine As Double
Application.DisplayAlerts = False
With
ThisWorkbook.VBProject.VBComponents(Worksheets(Wk.Name).CodeName).CodeModule
StartLine = .CreateEventProc("Change", "Worksheet") + 1
.InsertLines StartLine, "Dim Rngx As Range"
.InsertLines StartLine + 1, "rowx = Target.Row"
.InsertLines StartLine + 2, "colx = 7"
.InsertLines StartLine + 3, "Set Rngx = Range(Cells(rowx, 3),
Cells(rowx, colx))"
.InsertLines StartLine + 4, "If
WorksheetFunction.CountIf(Rngx, ""x"") > 1 Or
WorksheetFunction.CountIf(Rngx, ""X"") > 1 Then"
.InsertLines StartLine + 5, " MsgBox ""You can only rate
once!"""
.InsertLines StartLine + 6, " Target.ClearContents"
.InsertLines StartLine + 7, " Exit Sub"
.InsertLines StartLine + 8, "ElseIf
WorksheetFunction.CountIf(Rngx, ""x"") = 1 Or
WorksheetFunction.CountIf(Rngx, ""X"") = 1 Then"
.InsertLines StartLine + 9, " Cells(rowx, 1).Font.ColorIndex
= 5"
.InsertLines StartLine + 10, " Cells(rowx,
2).Font.ColorIndex = 5"
.InsertLines StartLine + 11, "ElseIf
WorksheetFunction.CountIf(Rngx, ""x"") = 0 Or
WorksheetFunction.CountIf(Rngx, ""X"") = 0 Then"
.InsertLines StartLine + 12, " Cells(rowx,
1).Font.ColorIndex = 3"
.InsertLines StartLine + 13, " Cells(rowx,
2).Font.ColorIndex = 3"
.InsertLines StartLine + 14, "End If"
.DeleteLines .CountOfLines - 1
End With
Application.DisplayAlerts = True
End Sub
Click to expand...
Click to expand...
 
B

Bernie Deitrick

Honestly, I try not to modify code by code - a lot of virus programs look for that, and block or
delete the files, and I've also found that it can be unstable and buggy. So, I would stick with the
workbook-based code. At the top, simply put this to block specific sheets:

If sh.Name = "BaseSheet" Or sh.Name = "Main" Then Exit Sub

If the sheets can be renamed by the users, then you need to use the sheet codenames to find the
current name: in this example, shtBaseSheet should be replaced with the codename of the BaseSheet,
etc.

If sh.Name = shtBaseSheet.Name Or sh.Name = shtMain.Name Then Exit Sub

HTH,
Bernie
MS Excel MVP


noname said:
Excellent Bernie :)

You solved my problem pending for so many days!

However, i still want to know what could be the problem with the
previous code. It should work ideally...is it because of the looping
or codename not identified during runtime?

If you want i can send u the copy of the original workbook so that you
can help me identify this problem..cos i use a lot of worksheet event
code module writing and this problem is a regular issue which i have
not been able to understand or capture....

And just to bring to you notice, this code will run on all sheets in
the workbook. This would be a problem because i have two initial
sheets "Main" which is a front-end where buttons n other initial data
is entered, and another sheet "BaseSheet" which stores values for
reference. So, is there a workaround for the same using the code which
u suggested to skip the 1st two sheets from the Workbook_Sheet_Change
code..

Looking forward to a learning experience from you regarding the same..


Cheers to you mate :D





The easiest way around this is to use the Workbook's sheet change event. The code below will do
the
same thing as having your code insert a new sheet change event into every sheet. Copy the code
into
the ThisWorkbook's codemodule.

HTH,
Bernie
MS Excel MVP

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Rngx As Range
rowx = Target.Row
colx = 7
Set Rngx = Sh.Range(Sh.Cells(rowx, 3), Sh.Cells(rowx, colx))
If WorksheetFunction.CountIf(Rngx, "x") > 1 Or _
WorksheetFunction.CountIf(Rngx, "X") > 1 Then
MsgBox "You can only rate once! """
Target.ClearContents
Exit Sub
ElseIf WorksheetFunction.CountIf(Rngx, "x") = 1 Or _
WorksheetFunction.CountIf(Rngx, "X") = 1 Then
Sh.Cells(rowx, 1).Font.ColorIndex = 5
Sh.Cells(rowx, 2).Font.ColorIndex = 5
ElseIf WorksheetFunction.CountIf(Rngx, "x") = 0 Or _
WorksheetFunction.CountIf(Rngx, "X") = 0 Then
Sh.Cells(rowx, 1).Font.ColorIndex = 3
Sh.Cells(rowx, 2).Font.ColorIndex = 3
End If

End Sub


Hi all,
Click to expand...
i have a sheet in which there are a range of Dept names.
Click to expand...
i m selecting the name n looping thru the names ...using each name i m
creating a new worksheet and then calling an event procedure macro to
insert worksheet change code in the activesheet....
Click to expand...
1] If the VBE Code window is not open, Excel gives an error "Error
9.....Subscript out of range"
Click to expand...
2] If the VBE Window is open, Excel crashes!!
Click to expand...
3] If there are multiple Dept names, Excel crashes!! Maybe Excel
crashing on multiple names the event module gets called multiple times
bcos of the loop....
Click to expand...
Can anyone find how to rectify this cos i cant keep the VBE code
window open for security reasons....if someone wants to see the file,
i can send them a sample....pls let me know asap.
Click to expand...
Main Module:
Click to expand...
For Each cell In Range("SkNm")
.........
........
.........
Click to expand...
'....Make a new Skill Sheet n populate with data .........
Dim Wk As Worksheet
Set Wk = Sheets.Add(after:=Sheets("BaseSheet"))
Wk.Name = skill
EventCode Wk
Set Wk = Nothing
Click to expand...
Cells(1, 1).Value = skill
Cells(1, 1).Interior.ColorIndex = 6
Cells(1, 1).Font.Bold = True
Cells(1, 1).Select
Call Borders(selection)
.........
..........
........
Click to expand...
end sub
Click to expand...
Event Code i m calling everytime:
-----------------------------------------------
Sub EventCode(Wk As Worksheet)
Wk.Activate
Dim StartLine As Double
Application.DisplayAlerts = False
With
ThisWorkbook.VBProject.VBComponents(Worksheets(Wk.Name).CodeName).CodeModule
StartLine = .CreateEventProc("Change", "Worksheet") + 1
.InsertLines StartLine, "Dim Rngx As Range"
.InsertLines StartLine + 1, "rowx = Target.Row"
.InsertLines StartLine + 2, "colx = 7"
.InsertLines StartLine + 3, "Set Rngx = Range(Cells(rowx, 3),
Cells(rowx, colx))"
.InsertLines StartLine + 4, "If
WorksheetFunction.CountIf(Rngx, ""x"") > 1 Or
WorksheetFunction.CountIf(Rngx, ""X"") > 1 Then"
.InsertLines StartLine + 5, " MsgBox ""You can only rate
once!"""
.InsertLines StartLine + 6, " Target.ClearContents"
.InsertLines StartLine + 7, " Exit Sub"
.InsertLines StartLine + 8, "ElseIf
WorksheetFunction.CountIf(Rngx, ""x"") = 1 Or
WorksheetFunction.CountIf(Rngx, ""X"") = 1 Then"
.InsertLines StartLine + 9, " Cells(rowx, 1).Font.ColorIndex
= 5"
.InsertLines StartLine + 10, " Cells(rowx,
2).Font.ColorIndex = 5"
.InsertLines StartLine + 11, "ElseIf
WorksheetFunction.CountIf(Rngx, ""x"") = 0 Or
WorksheetFunction.CountIf(Rngx, ""X"") = 0 Then"
.InsertLines StartLine + 12, " Cells(rowx,
1).Font.ColorIndex = 3"
.InsertLines StartLine + 13, " Cells(rowx,
2).Font.ColorIndex = 3"
.InsertLines StartLine + 14, "End If"
.DeleteLines .CountOfLines - 1
End With
Application.DisplayAlerts = True
End Sub


Hi,
Click to expand...
Can anybody help me with this as i m still getting error 9 even after
doin the above changes....

On Feb 6, 9:51 pm, "Bernie Deitrick" <deitbe @ consumer dot org>
wrote:

sheets.add after:=sheets(1)
call Proc1
Click to expand...
to
Dim mySht As Worksheet
Click to expand...
Set mySht = Sheets.Add(after:=Sheets(1))
Proc1 mySht
Click to expand...
And change the top of Proc1 to:
Click to expand...
Sub Proc1(Sht As Worksheet)
Dim StartLine As Double
Application.DisplayAlerts = False
With ThisWorkbook.VBProject.VBComponents(Sht.Name).CodeModule
StartLine = .CreateEventProc("Activate", "Worksheet") + 1
....
Click to expand...
HTH,
Bernie
MS Excel MVP
Click to expand...
I m trying to call a procedure say Proc1 in my code, which writes code
lines to a new worksheet for the events Activate and Change clubbed
together....
----------------------------------------------------
sub MYCODE
...
...
For each cell in CellRange
sheets.add after:=sheets(1)
call Proc1
next cell
...
...
End Sub
----------------------------------------------------
Sub Proc1
Dim StartLine As Double
With
ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(ActiveSheet.Name).CodeName).CodeModule
StartLine = .CreateEventProc("Activate", "Worksheet") + 1
.InsertLines StartLine + 0, "Dim r, c, AvailH, er, total, totemp
As Integer"
.InsertLines StartLine + 1, "Dim r1 As Range"
.InsertLines StartLine + 2, "Dim comstr As String"
.InsertLines StartLine + 3, "dt = Date"
.InsertLines StartLine + 4, "ActiveSheet.Unprotect"
.InsertLines StartLine + 5, "Range(Cells(1, ""B""), Cells(1,
Cells(1, ""B"").End(xlToRight).Column)).Select"
.InsertLines StartLine + 6, "Set f = Selection.Find(What:=dt,
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)"
.InsertLines StartLine + 7, "If Not f Is Nothing Then"
.InsertLines StartLine + 8, " c = f.Column"
.InsertLines StartLine + 9, "Else"
.InsertLines StartLine + 10, " c = 2"
.InsertLines StartLine + 11, "End If"
...........
............
.............
End Sub
Click to expand...
****************** Now, heres the puzzling part *******************
Now, if the VBE editor window is open, the code gets pasted properly
to the activesheet, BUT, if the VBE editor is not open, then its
results in an error "Run Time error - 9. Subscript out of range".
Click to expand...
When i click Debug, In the VBE code window its shows the 2nd line
above highlighted in yellow.
i.e.
With
ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(ActiveSheet.Name).CodeName).CodeModule
Click to expand...
I m not sure, but i think this kind of error usually occurs due to
some sheets.count overflow or something...
Click to expand...
Can anyone shed some light on this n how to rectify it......
Click to expand...
I dont want to keep the VBE editor code window open due to security
reasons.
Click to expand...
Regards,
Click to expand...
Click to expand...
Click to expand...
 
N

noname

Thanks Bernie,

I already did that to exclude the 2 starting sheets...but you are
right, its a good idea to use codenames instead of the regular
names...

Will implement that..Thanks mate :)




Honestly, I try not to modify code by code - a lot of virus programs look for that, and block or
delete the files, and I've also found that it can be unstable and buggy. So, I would stick with the
workbook-based code. At the top, simply put this to block specific sheets:

If sh.Name = "BaseSheet" Or sh.Name = "Main" Then Exit Sub

If the sheets can be renamed by the users, then you need to use the sheet codenames to find the
current name: in this example, shtBaseSheet should be replaced with the codename of the BaseSheet,
etc.

If sh.Name = shtBaseSheet.Name Or sh.Name = shtMain.Name Then Exit Sub

HTH,
Bernie
MS Excel MVP


Excellent Bernie :)
Click to expand...
You solved my problem pending for so many days!
Click to expand...
However, i still want to know what could be the problem with the
previous code. It should work ideally...is it because of the looping
or codename not identified during runtime?
Click to expand...
If you want i can send u the copy of the original workbook so that you
can help me identify this problem..cos i use a lot of worksheet event
code module writing and this problem is a regular issue which i have
not been able to understand or capture....
Click to expand...
And just to bring to you notice, this code will run on all sheets in
the workbook. This would be a problem because i have two initial
sheets "Main" which is a front-end where buttons n other initial data
is entered, and another sheet "BaseSheet" which stores values for
reference. So, is there a workaround for the same using the code which
u suggested to skip the 1st two sheets from the Workbook_Sheet_Change
code..
Click to expand...
Looking forward to a learning experience from you regarding the same..
Click to expand...
Cheers to you mate :D
Click to expand...
The easiest way around this is to use the Workbook's sheet change event.. The code below will do
the
same thing as having your code insert a new sheet change event into every sheet. Copy the code
into
the ThisWorkbook's codemodule.
HTH,
Bernie
MS Excel MVP
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Rngx As Range
rowx = Target.Row
colx = 7
Set Rngx = Sh.Range(Sh.Cells(rowx, 3), Sh.Cells(rowx, colx))
If WorksheetFunction.CountIf(Rngx, "x") > 1 Or _
WorksheetFunction.CountIf(Rngx, "X") > 1 Then
MsgBox "You can only rate once! """
Target.ClearContents
Exit Sub
ElseIf WorksheetFunction.CountIf(Rngx, "x") = 1 Or _
WorksheetFunction.CountIf(Rngx, "X") = 1 Then
Sh.Cells(rowx, 1).Font.ColorIndex = 5
Sh.Cells(rowx, 2).Font.ColorIndex = 5
ElseIf WorksheetFunction.CountIf(Rngx, "x") = 0 Or _
WorksheetFunction.CountIf(Rngx, "X") = 0 Then
Sh.Cells(rowx, 1).Font.ColorIndex = 3
Sh.Cells(rowx, 2).Font.ColorIndex = 3
End If
End Sub

Hi all,
i have a sheet in which there are a range of Dept names.
i m selecting the name n looping thru the names ...using each name i m
creating a new worksheet and then calling an event procedure macro to
insert worksheet change code in the activesheet....
1] If the VBE Code window is not open, Excel gives an error "Error
9.....Subscript out of range"
2] If the VBE Window is open, Excel crashes!!
3] If there are multiple Dept names, Excel crashes!! Maybe Excel
crashing on multiple names the event module gets called multiple times
bcos of the loop....
Can anyone find how to rectify this cos i cant keep the VBE code
window open for security reasons....if someone wants to see the file,
i can send them a sample....pls let me know asap.
Main Module:
------------------
Sub SkillAdd()
.......
.......
For Each cell In Range("SkNm")
.........
........
.........
'....Make a new Skill Sheet n populate with data .........
Dim Wk As Worksheet
Set Wk = Sheets.Add(after:=Sheets("BaseSheet"))
Wk.Name = skill
EventCode Wk
Set Wk = Nothing
Cells(1, 1).Value = skill
Cells(1, 1).Interior.ColorIndex = 6
Cells(1, 1).Font.Bold = True
Cells(1, 1).Select
Call Borders(selection)
.........
..........
........
end sub
Event Code i m calling everytime:
-----------------------------------------------
Sub EventCode(Wk As Worksheet)
Wk.Activate
Dim StartLine As Double
Application.DisplayAlerts = False
With
ThisWorkbook.VBProject.VBComponents(Worksheets(Wk.Name).CodeName).CodeModule
StartLine = .CreateEventProc("Change", "Worksheet") + 1
.InsertLines StartLine, "Dim Rngx As Range"
.InsertLines StartLine + 1, "rowx = Target.Row"
.InsertLines StartLine + 2, "colx = 7"
.InsertLines StartLine + 3, "Set Rngx = Range(Cells(rowx, 3),
Cells(rowx, colx))"
.InsertLines StartLine + 4, "If
WorksheetFunction.CountIf(Rngx, ""x"") > 1 Or
WorksheetFunction.CountIf(Rngx, ""X"") > 1 Then"
.InsertLines StartLine + 5, " MsgBox ""You can only rate
once!"""
.InsertLines StartLine + 6, " Target.ClearContents"
.InsertLines StartLine + 7, " Exit Sub"
.InsertLines StartLine + 8, "ElseIf
WorksheetFunction.CountIf(Rngx, ""x"") = 1 Or
WorksheetFunction.CountIf(Rngx, ""X"") = 1 Then"
.InsertLines StartLine + 9, " Cells(rowx, 1).Font.ColorIndex
= 5"
.InsertLines StartLine + 10, " Cells(rowx,
2).Font.ColorIndex = 5"
.InsertLines StartLine + 11, "ElseIf
WorksheetFunction.CountIf(Rngx, ""x"") = 0 Or
WorksheetFunction.CountIf(Rngx, ""X"") = 0 Then"
.InsertLines StartLine + 12, " Cells(rowx,
1).Font.ColorIndex = 3"
.InsertLines StartLine + 13, " Cells(rowx,
2).Font.ColorIndex = 3"
.InsertLines StartLine + 14, "End If"
.DeleteLines .CountOfLines - 1
End With
Application.DisplayAlerts = True
End Sub
Regards
:(
Hi,
Can anybody help me with this as i m still getting error 9 even after
doin the above changes....
Rgds,
On Feb 6, 9:51 pm, "Bernie Deitrick" <deitbe @ consumer dot org>
wrote:
Change
sheets.add after:=sheets(1)
call Proc1
to
Dim mySht As Worksheet
Set mySht = Sheets.Add(after:=Sheets(1))
Proc1 mySht
And change the top of Proc1 to:
Sub Proc1(Sht As Worksheet)
Dim StartLine As Double
Application.DisplayAlerts = False
With ThisWorkbook.VBProject.VBComponents(Sht.Name).CodeModule
StartLine = .CreateEventProc("Activate", "Worksheet") + 1
....
HTH,
Bernie
MS Excel MVP

Hi,
I m trying to call a procedure say Proc1 in my code, which writes code
lines to a new worksheet for the events Activate and Change clubbed
together....
----------------------------------------------------
sub MYCODE
...
...
For each cell in CellRange
sheets.add after:=sheets(1)
call Proc1
next cell
...
...
End Sub
----------------------------------------------------
Sub Proc1
Dim StartLine As Double
With
ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(ActiveSheet.Name).CodeName).CodeModule
StartLine = .CreateEventProc("Activate", "Worksheet") + 1
.InsertLines StartLine + 0, "Dim r, c, AvailH, er, total, totemp
As Integer"
.InsertLines StartLine + 1, "Dim r1 As Range"
.InsertLines StartLine + 2, "Dim comstr As String"
.InsertLines StartLine + 3, "dt = Date"
.InsertLines StartLine + 4, "ActiveSheet.Unprotect"
.InsertLines StartLine + 5, "Range(Cells(1, ""B""), Cells(1,
Cells(1, ""B"").End(xlToRight).Column)).Select"
.InsertLines StartLine + 6, "Set f = Selection.Find(What:=dt,
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)"
.InsertLines StartLine + 7, "If Not f Is Nothing Then"
.InsertLines StartLine + 8, " c = f.Column"
.InsertLines StartLine + 9, "Else"
.InsertLines StartLine + 10, " c = 2"
.InsertLines StartLine + 11, "End If"
...........
............
.............
End Sub
****************** Now, heres the puzzling part *******************
Now, if the VBE editor window is open, the code gets pasted properly
to the activesheet, BUT, if the VBE editor is not open, then its
results in an error "Run Time error - 9. Subscript out of range"..
When i click Debug, In the VBE code window its shows the 2nd line
above highlighted in yellow.
i.e.
With
ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(ActiveSheet.Name).CodeName).CodeModule
I m not sure, but i
Click to expand...
Click to expand...

...

read more »
Click to expand...
 

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

Similar Threads

getting text out of TextBox into code 0
Creating An Event Procedure 4
Xl 2007 v 2003 Re Populate ThisWorkbook via VBA 2
Creating ThisWorkbook Event Procedures 2
VB editor opens by magic 4
How can I hide VBE window appearing when running VB6 app 0
Excel crashes when programming to the VBA Editor 2
Add Procedure To Module Via VBA 2

Top