0

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 :)

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
lewin84
  • 1
  • 1
  • 1
    `Union` doesn't work across sheets. You could do each range separately or create an array of ranges, eg, https://stackoverflow.com/questions/25801941/vba-how-to-combine-two-ranges-on-different-sheets-into-one-to-loop-through – SJR Feb 18 '19 at 11:03
  • 1
    Note that `Dim r1, r2, myMultipleRange As Range` will declare only `myMultipleRange As Range` but `r1` and `r2` as `Variant`. You must specify a type for **every** variable in VBA `Dim r1 As Range, r2 As Range, myMultipleRange As Range` otherwise Excel assumes `Variant`. – Pᴇʜ Feb 18 '19 at 11:05
  • 1
    `1` Add a new sheet `2` Copy multiple range to the newly added sheet `3` Use that ONE range to mail across `4` Delete newly added sheet – Siddharth Rout Feb 18 '19 at 11:44

1 Answers1

0

If you want to write text from differnt worksheets in Excel, probably a good idea is to write them to a separate worksheet and refer from that worksheet. You have to come up with some business logic, to avoid data overlapping. E.g., start always from the last used cell.

Otherwise, a union from two different worksheets, would throw an error, as mentioned in the first comment of @SJR, like this:

Sub TestMe()

    Dim a As Range
    Dim b As Range
    Dim c As Range

    Set a = Worksheets(1).Range("A1:A10")
    Set b = Worksheets(2).Range("A1:B100")

    Set c = Union(a, b) 'Would be a 1004 error!  

End Sub
Vityata
  • 42,633
  • 8
  • 55
  • 100