Excel Emailing contents of a specific range by date selection

Hi Experts

Im wondering if you can help

Im putting together a simplistic sheet (attached) that contains some data from the Media per publication date. The sheet is split into sections of five rows starting at A1 that contains the Date, with the subsequent rows 2 to 5 containing the data. In total the first range is A1 : L5. This goes on so the next section range would be A6 : L10 and so on, with the date in cell A6 and the data in 7 to 10.

I have managed to get some code to email the contents of the first range and, aside from being able to alter this manually to email each section separately, what im asking is if there is a way in which a selection box can be added to the code, and additional code to search in Column A for a Date and email the contents of the subsequent for rows beneath.
For example, if I chose 25/04/2018, then the contents of range A17 : L20 would be emailed to the desired address.

Is this possible? Any help would be much appreciated

Jase AlexanderCompliance ManagerAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

byundtMechanical EngineerCommented:
I personally prefer to have code for Forms toolbar buttons in a regular module sheet rather than in the code pane for the worksheet. If you agree, Insert...Module and paste the code there, then delete the code from Sheet1 code pane and reassign the command button's On Action macro to the one in the regular module sheet. Regardless where you put the code, both subs below should go in the same place.

The modified Send_Range sub calls the DatePicker function, which displays an InputBox asking the user to enter a date. The code assumes the date will be in DMY format, but it will accept periods, hyphens or slashes as delimiters. If you write out the date like 25 July 2018, the code will accept that. If you enter just a day and month, the code assumes it will be in the current year. This function returns a Date variable type to the modified Send_Range sub.

Send_Range then takes this date and uses the Find method on column A to find a cell with that date. It then puts a 5 row by 12 column range in the email.
Sub Send_Range()
Dim cel As Range
Dim dat As Date
dat = DatePicker()

If dat <> 0 Then
    Set cel = ActiveSheet.Range("A1:A50").Find(dat, LookAt:=xlWhole)
    If Not cel Is Nothing Then
        cel.Resize(5, 12).Select
        ActiveWorkbook.EnvelopeVisible = True
        With ActiveSheet.MailEnvelope
            .Introduction = "Latest Information for Brexit"
            .Item.To = "jasona@jojomamanbebe.co.uk"
            .Item.Subject = "Brexit Information"
        End With
    End If
End If
End Sub

Function DatePicker() As Date
Dim s As String
Dim v As Variant
Dim dat As Date
On Error Resume Next
s = InputBox("What date do you want to export?")

If s <> "" Then
    'Assume that the date format is dd/mm/yyyy
    s = Replace(Replace(s, "-", "/"), ".", "/")
    v = Split(s, "/")
    Select Case UBound(v)
    Case 0
        dat = DateValue(s)
    Case 1
        dat = DateSerial(Year(Date), v(1), v(0))
    Case 2
        dat = DateSerial(v(2), v(1), v(0))
    Case Else
    End Select
End If
On Error GoTo 0
If dat <> 0 Then DatePicker = dat
End Function

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Jase AlexanderCompliance ManagerAuthor Commented:
HI Brad

Hope you are well

Thank you so much for this  - its pefect !!

It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.