| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Subscript out of range
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, |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Subscript out of range
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, |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Subscript out of range
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, |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Subscript out of range
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, |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Subscript out of range
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" wrote in message ... 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, |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Subscript out of range
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 On Feb 11, 6:51 pm, "Bernie Deitrick" <deitbe @ consumer dot org wrote: 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" wrote in message ... 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, |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Subscript out of range.... | Excel Programming | |||
| Subscript out of Range | Excel Programming | |||
| subscript out of range | Excel Programming | |||
| Subscript out of range | Excel Programming | |||
| Subscript Out of Range | Excel Programming | |||
Hybrid Mode
