LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 127
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Code to get text from part of a cell Keenman Excel Worksheet Functions 3 April 27th 06 04:41 AM
Bolding Part Of A Title By Code.... Bob Barnes Charts and Charting in Excel 7 October 29th 05 02:40 AM
Formula for Extracting Alphabetic Part of a Product Code ob3ron02 Excel Worksheet Functions 5 October 30th 04 12:35 PM
Hiding Part of the VBA Code Matt Excel Programming 5 June 7th 04 07:07 PM
Code and data part deux Terry von Gease Excel Programming 1 August 20th 03 07:48 AM


All times are GMT +1. The time now is 02:32 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"