Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
part of a code not being executed
Dear experts,
I have a problem with a block of code not being executed by Excel. It is a code to write some VBA script in another workbook on the same sheet, it has 2 parts: the first one to write a Worksheet_SelectionChange sub and the second one is to write a Worksheet_Change sub. No matter in which order I put the script, the Worksheet_SelectionChange part is always ingnored... Can you pls help me? Many thanks, Best regards, Valeria option explicit sub Valeria() Dim StartLine As Long Dim wsname As String Workbooks(Montly_Report).Worksheets("Approvals").A ctivate Range("a1").Select wsname = ActiveWorkbook.Worksheets("Approvals").CodeName With ActiveWorkbook.VBProject.VBComponents(wsname).Code Module StartLine = .CreateEventProc("SelectionChange", "Worksheet") + 1 .InsertLines StartLine, _ "Dim myRange As Range" & Chr(13) & _ "Set myRange = Range(""ID_Conf"")" & Chr(13) & _ "If Application.CellDragAndDrop = True And Application.Intersect(Target, myRange) Is Nothing Or Application.CellDragAndDrop = True And Target.Text = ""Y"" Then" & Chr(13) & _ "Exit Sub" & Chr(13) & _ "ElseIf Application.Intersect(Target, myRange) Is Nothing = False And Target.Text < ""Y"" Then" & Chr(13) & _ "Application.CellDragAndDrop = false" & Chr(13) & _ "Else" & Chr(13) & _ "Application.CellDragAndDrop = true" & Chr(13) & _ "End If" & Chr(13) StartLine = .CreateEventProc("Change", "Worksheet") + 1 .InsertLines StartLine, _ "dim vrange as range" & Chr(13) & "dim vvrange as range" & Chr(13) & "dim vvvrange as range" & Chr(13) & _ "Dim Ans As Integer" & Chr(13) & "Dim cell As Object" & Chr(13) & _ "Set vrange = Range(""ID_Conf"")" & Chr(13) & "Set vvvrange = Range(""Comment_Input"")" & Chr(13) & "Set vvrange = Range(""Approval_Granted_For"")" & Chr(13) & _ "Me.Unprotect Password:=""anseladams""" & Chr(13) & _ "Application.EnableEvents = False" & Chr(13) & Chr(13) & _ "On Error Resume Next" & Chr(13) & _ "For Each cell In Target" & Chr(13) & _ "If Union(cell, vrange).Address = vrange.Address Then" & Chr(13) & _ " If cell.Value = ""Y"" Then" & Chr(13) & _ "Target.Offset(0, 1).Value = Application.UserName" & Chr(13) & _ "Target.Offset(0, 2).Value = Format(Date, ""DD-MMM-YYYY"")" & Chr(13) & "Target.Offset(0, 3).Locked = False" & Chr(13) & _ "elseif cell.Value = ""N"" And cell.Offset(0, 5) < """" then" & Chr(13) & _ "Target.Offset(0, 1).Value = Application.UserName" & Chr(13) & "Target.Offset(0, 2).Value = Format(Date, ""DD-MMM-YYYY"")" & Chr(13) & _ "Target.Offset(0, 3) = ""3""" & Chr(13) & "Target.Offset(0, 3).Locked = True" & Chr(13) & _ "Target.Offset(0, 4) = Month(Now - 33 + 30*Target.Offset(0, 3)) & ""/"" & ""01/"" & Year(Now - 33 + 30)" & Chr(13) & _ "ElseIf cell.Value = ""N"" And cell.Offset(0, 5) = """" Then" & Chr(13) & _ "Ans = MsgBox(""Before you can reject a violation, you must enter"" & Chr(13) & ""an action plan (in the Actions column)!"", 16, ""PLEASE READ"")" & Chr(13) & _ "cell.Value = """"" & Chr(13) & "Application.CellDragAndDrop = False" & Chr(13) & " End If" & Chr(13) & _ "ElseIf Union(cell, vvrange).Address = vvrange.Address Then" & Chr(13) & _ "Target.Offset(0, 1).Value = Month(Now -33 + 30 * Target.Cells.Value) & ""/"" & ""01/"" & Year(Now -33 + 30 * Target.Cells.Value)" & Chr(13) & _ "ElseIf Union(cell, vvvrange).Address = vvvrange.Address Then" & Chr(13) & Chr(13) & "if cell.EntireRow.Hidden = False then" & Chr(13) & "cell.Comment.Delete" & Chr(10) & "cell.AddComment" & Chr(13) & "cell.Comment.Visible = False" & Chr(13) & _ "cell.Comment.Text Text:=Application.UserName & Chr(10) & Format(Date, ""DD-MMM-YYYY"")" & Chr(13) & "cell.Comment.Shape.TextFrame.AutoSize = True" & Chr(13) & _ "End If" & Chr(13) & "End If" & Chr(13) & "Next cell" & Chr(13) & "On Error GoTo 0" & Chr(13) & "Application.enableevents = true" & Chr(13) & _ "Me.Protect Password:=""password"", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowFormattingColumns:=false,AllowFormattingRows: =True, AllowSorting:=True, AllowFiltering:=True" End With End Sub -- Valeria |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Code to get text from part of a cell | Excel Worksheet Functions | |||
Bolding Part Of A Title By Code.... | Charts and Charting in Excel | |||
Formula for Extracting Alphabetic Part of a Product Code | Excel Worksheet Functions | |||
Hiding Part of the VBA Code | Excel Programming | |||
Code and data part deux | Excel Programming |