Guest User

Untitled

a guest
Jul 16th, 2018
79
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.96 KB | None | 0 0
  1. Dim Startline As Long
  2. Startline = 1
  3. Dim x As Integer
  4. x = Errors.Count - 1
  5.  
  6. Dim rng As Range
  7. Set rng = Range("D" & LastRow - x & ":" & "D" & LastRow)
  8.  
  9. With ThisWorkbook.VBProject.VBComponents(VRS.CodeName).CodeModule
  10. Startline = .CreateEventProc("Change", "Worksheet") + 1
  11. .InsertLines Startline, "Dim rng As Range "
  12. Startline = Startline + 1
  13. .InsertLines Startline, "Set rng = Range(" & """" & CStr(rng.Address) & """" & ")"
  14. Startline = Startline + 1
  15. .InsertLines Startline, "If Target.Count > 1 Then Exit Sub"
  16. Startline = Startline + 1
  17. .InsertLines Startline, "If Intersect(Target, rng) Is Nothing Then Exit Sub"
  18. Startline = Startline + 1
  19. .InsertLines Startline, "MsgBox (""Value Changed!..."") "
  20. End With
  21.  
  22. Private Sub Worksheet_Change(ByVal Target As Range)
  23. Dim rng As Range
  24. Set rng = Range("D58:D62")
  25. If Target.Count > 1 Then Exit Sub
  26. If Intersect(Target, rng) Is Nothing Then Exit Sub
  27. MsgBox ("Value Changed!...")
  28. End Sub`
  29.  
  30. Run-time error '9': Subscript out of range
  31.  
  32. With ThisWorkbook.VBProject.VBComponents(WS.CodeName).CodeModule
  33.  
  34. Startline = .CreateEventProc("Change", "Worksheet") + 1
  35.  
  36. Sub Main()
  37.  
  38. Dim ws As Worksheet
  39. Dim rng As Range
  40. Dim sCode As String
  41.  
  42. Set ws = ThisWorkbook.Worksheets.Add
  43. Set rng = ws.Range("D1:D10")
  44.  
  45. sCode = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbNewLine & vbNewLine
  46. sCode = sCode & vbTab & "Dim rng As Range" & vbNewLine & vbNewLine
  47. sCode = sCode & vbTab & "Set rng = Me.Range(" & """" & rng.Address & """" & ")" & vbNewLine & vbNewLine
  48. sCode = sCode & vbTab & "If Target.Count > 1 Then Exit Sub" & vbNewLine
  49. sCode = sCode & vbTab & "If Intersect(Target, rng) Is Nothing Then Exit Sub" & vbNewLine & vbNewLine
  50. sCode = sCode & vbTab & "MsgBox (""Value Changed!..."") " & vbNewLine
  51. sCode = sCode & "End Sub"
  52.  
  53. ThisWorkbook.VBProject.VBComponents(ws.CodeName).CodeModule.AddFromString sCode
  54.  
  55. End Sub
Add Comment
Please, Sign In to add comment