Darren Bartrup
Well-known Member
- Joined
- Mar 13, 2006
- Messages
- 1,297
- Office Version
- 365
- Platform
- Windows
Morning all,
I've written this code in Excel 2002, but it needs to run on earlier versions of Excel (the earliest version could be Excel 97).
Can anyone let me know if there's any commands that wouldn't work in earlier versions please, as our IT department refuse to do anything unless they've built it (and charged us thousands of pounds for the privilage).
In Sheet2:
The first two procedures execute the SendEmail procedure when a command button is pressed.
The second procedure locks and unlocks certain cells depending on the contents of other cells, and generally directs the user around the form. The only command I'm not sure about is EnableEvents.
In modEmail module:
The above code checks the worksheet for missing answers, and then lists any in a message box. If there are no missing answers then the workbook is emailed back to me using the SendMail command.
I've tried to keep the code as simple as possible, but if anyone could give it a quick once over I'd be very grateful.
I've written this code in Excel 2002, but it needs to run on earlier versions of Excel (the earliest version could be Excel 97).
Can anyone let me know if there's any commands that wouldn't work in earlier versions please, as our IT department refuse to do anything unless they've built it (and charged us thousands of pounds for the privilage).
In Sheet2:
Code:
Option Explicit
Private Sub cmdReturnEmail1_Click()
SendEMail
End Sub
Private Sub cmdReturnEmail2_Click()
SendEMail
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With ActiveSheet
.Unprotect
Select Case Target.Address
Case "$B$40", "$B$40:$G$40"
If Target.Text <> "Other" Or Target.Text = "" Then
.Range("B41") = ""
.Range("B41:G41").Locked = True
Else
.Range("B41:G41").Locked = False
.Range("B41").Activate
End If
Case "$G$44"
If Target.Text = "Yes" Then
.Range("D35") = "13th - 19th November"
ElseIf Target.Text = "No" And _
.Range("D35") = "13th - 19th November" Then
.Range("D35").Activate
MsgBox "Please enter the new survey week.", _
vbInformation + vbOKOnly, "Grant Funded Survey"
End If
If Target.Text = "No" Then
.Range("C53:F53").Locked = True
Else
.Range("C53:F53").Locked = False
End If
Case "$G$62"
If Target.Text = "Yes" Then
.Range("C63:G63").Locked = False
.Range("C63").Activate
ElseIf Target.Text = "No" Or Target.Text = "" Then
.Range("C63") = ""
.Range("C63:G63").Locked = True
End If
End Select
.Protect
End With
Application.EnableEvents = True
End Sub
The second procedure locks and unlocks certain cells depending on the contents of other cells, and generally directs the user around the form. The only command I'm not sure about is EnableEvents.
In modEmail module:
Code:
Option Explicit
Option Base 1
Sub SendEMail()
Dim wrkSht As Worksheet
Dim arrMissedFields() As String
Dim iCntr1 As Integer
Dim MissingAnswers() As String
Dim strMsgText As String
Set wrkSht = ThisWorkbook.Worksheets(2)
If Trim(wrkSht.Cells(8, 2)) = "" Then
IncreaseElement MissingAnswers
MissingAnswers(UBound(MissingAnswers)) = "Organisation name"
End If
.
.
'//Lots more statements like the one above
.
.
On Error GoTo SendMail
If UBound(MissingAnswers) >= 1 Then
strMsgText = "Please complete the following questions before sending the email:" & Chr(10) & Chr(10)
For iCntr1 = LBound(MissingAnswers) To UBound(MissingAnswers)
strMsgText = strMsgText & MissingAnswers(iCntr1) & Chr(10)
Next iCntr1
MsgBox strMsgText, vbCritical + vbOKOnly, "Grant Funded Survey 2006"
Exit Sub
End If
SendMail:
ThisWorkbook.SendMail "myemail@mycompany.com", _
"Grant Funded Survey Return from " & _
ThisWorkbook.Worksheets("Organisation").Cells(8, 2)
MsgBox "This Grant Funded Survey form has been returned" & Chr(10) & _
"If you have more than one scheme, please complete the form for each scheme and " & _
"email separately", vbOKOnly
End Sub
Code:
Sub IncreaseElement(MissingAnswers)
On Error GoTo OutOfRange
ReDim Preserve MissingAnswers(UBound(MissingAnswers) + 1)
On Error GoTo 0
Exit Sub
OutOfRange:
ReDim MissingAnswers(1)
End Sub
The above code checks the worksheet for missing answers, and then lists any in a message box. If there are no missing answers then the workbook is emailed back to me using the SendMail command.
I've tried to keep the code as simple as possible, but if anyone could give it a quick once over I'd be very grateful.