Limit user selected range

[Ben AFF]

Hi, I have a Macro that allows the user to send email based on selection of rows on a spreadsheet.
I want to limit the range within which the user selection is valid to columns A:B only.
Please can you help me? Thank you.

Sub ExcelToOutlookSR()
Dim mApp As Object
Dim mMail As Object
Dim SendToMail As String
Dim MailSubject As String
Dim mMailBody As String
For Each r In Selection
SendToMail = Range("M" & r.Row)
MailSubject = Range("K" & r.Row)
mMailBody = Range("L" & r.Row)
Set mApp = CreateObject("Outlook.Application")
Set mMail = mApp.CreateItem(0)
With mMail
.To = SendToMail
.Subject = MailSubject
.Body = mMailBody
.Display
End With
Next r
End Sub

 

[Akuini]

Yes, precisely.

Ok, I'll try to write the code tomorrow.

 

[Ben AFF]

Ok, I'll try to write the code tomorrow.

Thank you much Akuini.

 

[Akuini]

Question:
Why do you allow users to select col B? I don't see the code will do anything different if for example they select A2:A3 or B2:B3.

 

[Ben AFF]

Question:
Why do you allow users to select col B? I don't see the code will do anything different if for example they select A2:A3 or B2:B3.

In fact you are right Akuini. Initially I thought to allow users only use A:B because its where the Purchase Order information and the item number are saved. But you where right that it would generate 2 mails per row. So I only need to have the user select Column A but consolidate in a single mail based on column B. Then in column L is where I stored the mail body for each item.

PS: can I buy you a beer or coffee ?

Purchase Order Number	Purchase Order Item	Mail Body
ABC	01	Purchase Order Number ABC Item 01
ABC	02	Purchase Order Number ABC Item 02
DEF	01	Purchase Order Number DEF Item 01
DEF	02	Purchase Order Number DEF Item 02

 

[Akuini]

What should happen if user select A2? Should the mailBody also get value from L4 because B2 & B4 have the same value?

 

[Ben AFF]

What should happen if user select A2? Should the mailBody also get value from L4 because B2 & B4 have the same value?

Thank you Akuini,

No, in that scenario,
If the user select A2, then the mail body would get values from L1 & L2
If the user select A1, then the mail body would get values from L1 & L2
...
The grouping of should happen based on repeat values in column A.

 

[Akuini]

The grouping of should happen based on repeat values in column A.

but what did you mean by this:

So I only need to have the user select Column A but consolidate in a single mail based on column B.

 

[Ben AFF]

but what did you mean by this:

sorry, I explained badly in this first comment.

 

[Akuini]

Ok, try this:
The criteria:
User can only select range with data in Column A & consolidate in a single mail based on duplicate values in column A & get values from col L to populate the mMailBody.

Sub ExcelToOutlookSR_2()
Dim mApp As Object
Dim mMail As Object
Dim SendToMail As String
Dim MailSubject As String
Dim mMailBody As String
Dim r As Range, n As Long
Dim d As Object, f As Object
Dim tx As String
Dim x, ary, g

If Not Intersect(Selection, Range("A:A")) Is Nothing And Intersect(Selection, Range("B:XFD")) Is Nothing Then

    n = Range("A" & Rows.Count).End(xlUp).Row 'get last row with data in col A
    If Not Intersect(Selection, Range("A2:A" & n)) Is Nothing Then
        Set d = CreateObject("scripting.dictionary"):        d.CompareMode = vbTextCompare
        Set f = CreateObject("scripting.dictionary"):        f.CompareMode = vbTextCompare
        
        For Each r In Intersect(Selection, Range("A2:A" & n))
            f(r.Value) = Empty
        Next
        
        For Each r In Range("A2:A" & n)
            tx = r.Value
            If f.Exists(tx) Then
                If Not d.Exists(tx) Then
                    d(tx) = r.Row
                Else
                    d(tx) = d(tx) & " " & r.Row
                End If
            End If
        Next
       
        For Each x In d
            ary = Split(d.Item(x), " ")
            SendToMail = Range("M" & ary(0))
            MailSubject = Range("K" & ary(0))
            tx = ""
            For Each g In ary
                tx = tx & vbLf & Range("L" & g)
            Next
            mMailBody = Mid(tx, 2)
'            Debug.Print mMailBody
            Set mApp = CreateObject("Outlook.Application")
            Set mMail = mApp.CreateItem(0)
            With mMail
                .To = SendToMail
                .Subject = MailSubject
                .Body = mMailBody
                .Display
            End With
        Next
    Else
        MsgBox "Please, select cells with data in column A only."
    End If
Else
    MsgBox "Please, select cells with data in column A only."
End If

End Sub

 

[Ben AFF]

Ok, try this:
The criteria:
User can only select range with data in Column A & consolidate in a single mail based on duplicate values in column A & get values from col L to populate the mMailBody.

Sub ExcelToOutlookSR_2()
Dim mApp As Object
Dim mMail As Object
Dim SendToMail As String
Dim MailSubject As String
Dim mMailBody As String
Dim r As Range, n As Long
Dim d As Object, f As Object
Dim tx As String
Dim x, ary, g

If Not Intersect(Selection, Range("A:A")) Is Nothing And Intersect(Selection, Range("B:XFD")) Is Nothing Then

    n = Range("A" & Rows.Count).End(xlUp).Row 'get last row with data in col A
    If Not Intersect(Selection, Range("A2:A" & n)) Is Nothing Then
        Set d = CreateObject("scripting.dictionary"):        d.CompareMode = vbTextCompare
        Set f = CreateObject("scripting.dictionary"):        f.CompareMode = vbTextCompare
       
        For Each r In Intersect(Selection, Range("A2:A" & n))
            f(r.Value) = Empty
        Next
       
        For Each r In Range("A2:A" & n)
            tx = r.Value
            If f.Exists(tx) Then
                If Not d.Exists(tx) Then
                    d(tx) = r.Row
                Else
                    d(tx) = d(tx) & " " & r.Row
                End If
            End If
        Next
      
        For Each x In d
            ary = Split(d.Item(x), " ")
            SendToMail = Range("M" & ary(0))
            MailSubject = Range("K" & ary(0))
            tx = ""
            For Each g In ary
                tx = tx & vbLf & Range("L" & g)
            Next
            mMailBody = Mid(tx, 2)
'            Debug.Print mMailBody
            Set mApp = CreateObject("Outlook.Application")
            Set mMail = mApp.CreateItem(0)
            With mMail
                .To = SendToMail
                .Subject = MailSubject
                .Body = mMailBody
                .Display
            End With
        Next
    Else
        MsgBox "Please, select cells with data in column A only."
    End If
Else
    MsgBox "Please, select cells with data in column A only."
End If

End Sub

Thank you so much Akuini, it works perfect. I dont know how to thank you, wish I could by you a coffee or beer