I have an Excel request form, where, after a sheet is filled out and the Send button is clicked, certain cells are selected and then sent as a text via email.
Private Sub AutoSend()
'THIS CHECKS THAT ALL PINK CELLS ARE COMPLETED
Dim cell As Range
Dim bIsEmpty As Boolean
bIsEmpty = False
For Each cell In Range("B6:B9,B11:B13")
If IsEmpty(cell) = True Then
bIsEmpty = True
Exit For
End If
Next cell
'THIS DISPLAYS AN ERROR MESSAGE IF ONE OR MORE PINK CELLS ARE NOT FILLED OUT
If bIsEmpty = True Then
MsgBox "Please fill out EACH CELL highlighted in pink."
Exit Sub
End If
'THIS DISPLAYS AN ERROR MESSAGE IF CUSTOMER ANSWERS "NO" TO BOTH "IS FULL MAILBOX ACCESS REQUESTED?" AND "IS SEND AS ACCESS REQUESTED"
If (Range("B11").Value = "No" And Range("B12").Value = "No") Then
MsgBox "You have answered 'no' to both questions in the 'Type of Access' section. You need to answer 'yes' to at least one question in order to proceed."
Exit Sub
End If
'THIS STARTS SENDING THE REQUEST TO THE TEAM IF ALL IS FILLED OUT PROPERLY
If MsgBox("Are you sure you want to proceed?", vbYesNo) = vbNo Then Exit Sub
AutoSend_Notification.StartUpPosition = 0
AutoSend_Notification.Left = Application.Left + (0.5 * Application.Width) - (0.5 * AutoSend_Notification.Width)
AutoSend_Notification.Top = Application.Top + (0.5 * Application.Height) - (0.5 * AutoSend_Notification.Height)
AutoSend_Notification.Show
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
'Only the visible cells in the selection
Sheet4.Unprotect ("XY4lZ6n0ElvCmQ!r")
Set rng = Sheet4.Range("A1:C2,A5:B13").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "xxx@yyy.com"
.CC = ""
.BCC = ""
.Subject = "" & Sheet4.Range("A1").Value
.HTMLBody = RangetoHTML(rng)
.Send 'or use .Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
msg = MsgBox("Thank you! Your request has been submitted. Within a few moments you will receive an e-mail with a ticket number to confirm that we have received your request. This form will be automatically closed now.", vbInformation)
'END EMAIL SCRIPT
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Exit Sub
End Sub
I am mainly concerned about this part of the code:
Sheet4.Unprotect ("XY4lZ6n0ElvCmQ!r")
Set rng = Sheet4.Range("A1:C2,A5:B13").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
As you see, the above code is copying cells only in the Sheet4. What I need to do is to include one more range which is located in the "xlSheetVeryHidden" Sheet1 (Sheet1.Range("A1:D1").
I've tried the Union
function, but got an error:
Sheet4.Unprotect ("XY4lZ6n0ElvCmQ!r")
Sheet1.Unprotect ("XY4lZ6n0ElvCmQ!r")
Dim r1, r2, myMultipleRange As Range
Set r1 = Sheet4.Range("A1:C2,A5:B13").SpecialCells(xlCellTypeVisible)
Set r2 = Sheet1.Range("A1:D1")
Set myMultipleRange = ApXL.Union(r1, r2)
On Error GoTo 0
I've tried the AND
function, but got an error too:
Sheet4.Unprotect ("4F4lZ6n0ElvCmQ!r")
Sheet1.Unprotect ("4F4lZ6n0ElvCmQ!r")
Set rng = Sheet4.Range("A1:C2,A5:B13").SpecialCells(xlCellTypeVisible) And Sheet1.Range("A1:D1")
On Error GoTo 0
So, my question is, how can I add the Sheet1.Range("A1:D1") range to the following code so both Sheet4 and Sheet1 ranges are copied into the automatically sent email?
Sheet4.Unprotect ("XY4lZ6n0ElvCmQ!r")
Set rng = Sheet4.Range("A1:C2,A5:B13").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
I've tried to search the topics here but couldn't find anything in particular that would fit this issue so apologies if I have overlooked anything.
Also please note that I'm a beginner in VBA so I realize there might be flaws in the code :)