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

:(






On Feb 8, 4:11 pm, noname wrote:
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).Code Module
StartLine = .CreateEventProc("Activate", "Worksheet") + 1
....

HTH,
Bernie
MS Excel MVP

"noname" wrote in message

...

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.S heets(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.S heets(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,