200+ Video Lessons
50+ Hours of Video
200+ Excel Guides
Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)
Hi,
I have a workbook with 3 dependent drop downs, is there a Macro which will slowly work through the drop downs and email each one to the relevant recipient (Cell ref for the email address). I know there is a Macro to send the email, it's the macro to cycle through the drop down boxes (which terminates after the last one has been sent) that i'm after?
Sample file attached.
Many Thanks
Boytjie79
Please find my working version of your file (attached).
I've assumed that once you've set the Month in the scorecard, you want to go through each Brand then each area (for that Brand) then each Store with that and send the scorecard for that store. My macro sets the scorecard to the those values then creates an HTML email of the scorecard (if could be a pdf with a different module from Ron de Bruin).
Run code (under Module 3) to do that (note it currently prepares 37 drafts - or however many are in the linked "dropdown" cell validation columns in Defined) and will take a few seconds to run...
Sub Loop_cells()
MsgBox "Macro will prepare several draft emails- please wait for completion message"
'Application.ScreenUpdating = False ' disable for speed
With Sheet13
For m = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'With Sheet13
'Debug.Print .Cells(m, 1)
h = FindHeadingColumn(.Cells(m, 1))
For n = 2 To .Cells(.Rows.Count, h).End(xlUp).Row
'Debug.Print vbTab & .Cells(n, h)
j = FindHeadingColumn(.Cells(n, h))
For p = 2 To .Cells(.Rows.Count, j).End(xlUp).Row
'Debug.Print vbTab & vbTab & .Cells(p, j)
'prepare scoerecard for individual store
Sheet1.Range("E2") = .Cells(m, 1) 'Set Brand in Scorecard
Sheet1.Range("E4") = .Cells(m, h) 'Set Area in Scorecard
Sheet1.Range("E5") = .Cells(p, j) 'Set Store in Scorecard
'MsgBox .Cells(m, 1) & "/" & .Cells(n, h) & "/" & .Cells(p, j)
Send_Store_email (.Cells(p, j).Address) ' pass Sheet13 address of store
Next p
Next n
Next m
End With
'Application.ScreenUpdating = True 'restore once done
MsgBox "Draft emails prepared- please look in draft folder in Outlook (then send)"
End SubREVISION 1: disabled Application.ScreenUpdating lines in this sub since occasionally an email address was missing- revised file attached. If you don't have that problem, uncomment them but it may be useful to see the scorecard updating - you might also find it useful to watch the emails appearing in the Drafts folder in Outlook.
(Note that one MsgBox line and the Debug.print lines are commented out - they were used to test the looping was working correctly- but you could restore them and comment out the Send_Store_email line if you just wanted to see the loop working without creating the draft emails, checking in th Immediate window of VB Explorer)
It looks in the first column of Defined then a loop looks for the entry (e.g. "BRAND_1") in the headings via a function called FindHeadingColumn (also it that module) and then does the same for the Areas and then the Stores (in successive nested loops). Once it gets to the Store level, it sets the scorecard to those values and calls my email sub Send_Store_email, parsing the cell address linked with that Store. The scorecard settings and that address are used in preparing the individual email, plus the next door cell to Store is used for the email address (you'll see I've added new columns in Defined for that- please change the addresses to suit).
That sub calls a function created by Ron de Bruin which converts an email intro (I've added in Defined) and the scorecard into an Html body.
At present the Send_Store_email sub doesn't display the emails or send them but you could uncomment .Send (and comment out .Save) once you're confident it's working correctly.
Hope this is what you need.
Sub Send_Store_email(StoreAdd As String)
'
' Macro to populate and send emails, based on an brand area and store (with associated scorecard)
'
Dim objOutl As Object, objMess As Object
Dim rng As Range, rng2 As Range
On Error Resume Next
Set rng = Nothing
Application.ScreenUpdating = False
Set objOutl = CreateObject("Outlook.Application") 'Grab Outlook
'jOutl.Visible = True
'MsgBox objOutl.Session.CurrentUser.Name ' Identify Outlook user
Set rng = Sheet1.Range("B2:V20").SpecialCells(xlCellTypeVisible) ' set to Scorecard area
Set rng2 = Sheet2.Range("B1:R61").SpecialCells(xlCellTypeVisible) ' set to extra info cells
Set objMess = objOutl.CreateItem(olMailItem) '
With objMess
.To = Sheet13.Range(StoreAdd).Offset(0, 1) '### get email address from next column
'.cc = Sheet1.Cells(3, 27) '### change this
.Subject = StrConv(Sheet1.Range("E2") & "- " & Sheet1.Range("E3"), vbProperCase) & " Scorecard for " & Sheet13.Range(StoreAdd) '### change this
.HTMLBody = RangetoHTML(Sheet13.Range("L23")) & RangetoHTML(rng) & RangetoHTML(rng2) ''### change intro?
.Save
'.Display
'.send
End With
Application.ScreenUpdating = True
Set objMess = Nothing
End SubHere is the code that loops through your store names.
Sub EmailForAll()
Dim C As Long ' loop counter: columns
Dim R As Long ' loop counter: rows
With Worksheets("Defined")
For C = 4 To 7 ' representing columns D to G
' start in row 2
For R = 2 To .Cells(.Rows.Count, C).End(xlUp).Row
With .Cells(R, C)
' the Value property contains the store's name
' which you can use to retrieve the email address
' from another list.
Debug.Print .Address(0, 0) & " = " & .Value
End With
Next R
Next C
End With
End Sub