All,
I am facing an error with a some VBA code in an Excel macro. Here’s the workflow I am attempting:
Once I know this range, I use the code below to write to the newly created worksheets codemodule so I can set up a ‘change_event’. I only want the change_event to trigger when the values in the range I just determined are changed:`
Dim Startline As Long
Startline = 1
Dim x As Integer
x = Errors.Count - 1
Dim rng As Range
Set rng = Range("D" & LastRow - x & ":" & "D" & LastRow)
With ThisWorkbook.VBProject.VBComponents(VRS.CodeName).CodeModule
Startline = .CreateEventProc("Change", "Worksheet") + 1
.InsertLines Startline, "Dim rng As Range "
Startline = Startline + 1
.InsertLines Startline, "Set rng = Range(" & """" & CStr(rng.Address) & """" & ")"
Startline = Startline + 1
.InsertLines Startline, "If Target.Count > 1 Then Exit Sub"
Startline = Startline + 1
.InsertLines Startline, "If Intersect(Target, rng) Is Nothing Then Exit Sub"
Startline = Startline + 1
.InsertLines Startline, "MsgBox (""Value Changed!..."") "
End With
The code works, and writes the following into the codemodule of the specified worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("D58:D62")
If Target.Count > 1 Then Exit Sub
If Intersect(Target, rng) Is Nothing Then Exit Sub
MsgBox ("Value Changed!...")
End Sub`
This code works too, and the message box appears when the cells in the range are changed. However, with the VBE closed it will produce the the error:
Run-time error '9': Subscript out of range
Hitting debug takes me to the the line:
With ThisWorkbook.VBProject.VBComponents(WS.CodeName).CodeModule
But it actually throws the error on the following line:
Startline = .CreateEventProc("Change", "Worksheet") + 1
I'm not sure why you're getting that error, but here's another approach that will avoid it
Sub Main()
Dim ws As Worksheet
Dim rng As Range
Dim sCode As String
Set ws = ThisWorkbook.Worksheets.Add
Set rng = ws.Range("D1:D10")
sCode = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbNewLine & vbNewLine
sCode = sCode & vbTab & "Dim rng As Range" & vbNewLine & vbNewLine
sCode = sCode & vbTab & "Set rng = Me.Range(" & """" & rng.Address & """" & ")" & vbNewLine & vbNewLine
sCode = sCode & vbTab & "If Target.Count > 1 Then Exit Sub" & vbNewLine
sCode = sCode & vbTab & "If Intersect(Target, rng) Is Nothing Then Exit Sub" & vbNewLine & vbNewLine
sCode = sCode & vbTab & "MsgBox (""Value Changed!..."") " & vbNewLine
sCode = sCode & "End Sub"
ThisWorkbook.VBProject.VBComponents(ws.CodeName).CodeModule.AddFromString sCode
End Sub
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With