I have the below code on one of my sheets.
The first sub creates a meeting event in outlook based on what initals are in a rannge of cells, links their email address and takes data from the sheet to generate the event.
The second creates a temporaary note whenever a cell is clicked in a range that has a letter in the cell, to display the full name associated with that letter.
Ive protected my sheet however when i run create meeting macro by double clicking the cell i specified as the initialiser, the macro wont work if the sheet is protected, yet works fine when it isnt. i need to add the sheets.Unprotect syntax to my code but in the places ive tried it hasnt been sucessful.
I do not want to set a password when i protect the sheet - im using it simply as a mistake handler so people dont delete code with formulas included.
Any help?
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Sheets("Sheet2").Unprotect Password:="whatever"
Dim OutApp As Object
Dim ObjOutlook As Object
Dim ObjMeeting As Object
Dim OutMail As Object
Dim r As Long
Dim c As Long
Dim strTo As String
Dim strAddress As String
If Target.CountLarge > 1 Then Exit Sub
If Target.Column <> 2 Then Exit Sub
Cancel = True
'Set MailList = Worksheets("Sheet1").Range("MailList")
r = Target.Row
For c = 11 To 21
If Cells(r, c).Value <> "" Then
strAddress = Evaluate("IFERROR(VLOOKUP(""" & Cells(r, c).Value & """, AllStaff,2,FALSE),"""")")
If strAddress <> "" Then
strTo = strTo & "; " & strAddress
End If
End If
Next c
Set ObjOutlook = CreateObject("Outlook.Application")
Set ObjMeeting = ObjOutlook.CreateItem(1)
ObjOutlook.Session.Logon
ObjMeeting.Display
On Error Resume Next
With ObjMeeting
.Meeting = 1
If strTo <> "" Then
.RequiredAttendees = Mid(strTo, 3)
End If
.Subject = Range("C" & r) & " - " & Range("E" & r) & " " & Range("F" & r) & " - " & Range("J" & r)
.Start = Range("F" & r).Value & " " & Format(Range("G" & r).Value, "h:mm")
.Duration = 480
.ReminderSet = False
.BusyStatus = 0
.Body = "This is the actual event start time. Please arrive in advance at the office. Please accept this meeting but select 'Do not send response' if possible. Unless you need to decline, then let me know with a response. ----- " & Range("C" & r) & " ----- " & Range("E" & r) & " ----- " & Range("F" & r) & " ----- " & "Please, check this schedule for the weekend, if there are any problems or conflicts, contact me ASAP. Thank you!"
.Display
End With
Sheets("Sheet1").Protect Password:="whatever"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim c As Range
Dim r As Range
Set r = Range("Allocations") 'Change to actual range where initials are entered
If Not Intersect(Target, r) Is Nothing Then
r.ClearComments
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
Target.AddComment
Target.Comment.Visible = True
Target.Comment.Text Text:=Application.VLookup(Target.Value, Worksheets("Dropdowns").Range("AllStaff"), 3, False)
Target.Comment.Shape.TextFrame.Characters.Font.Size = 10
Target.Comment.Shape.TextFrame.AutoSize = True
End If
End Sub