I have an Excel workbook that is use to keep track of employee attendance. One of the sheets, EE Attendance Calendar, has a Data Validation list in cell A4. The list is of employee names and is pulled from a named range of cells in different sheet, Employee Data, in the same workbook (named range is Name and refers to 'Employee Data'!$A$3:$A$102). When an employee’s name is selected, other cells in the EE Attendance Calendar sheet pull data for that employee from other sheets in the workbook.
I wanted to email a portion of the EE Attendance Calendar sheet to each employee, so I decided to create a macro I could assign to a button. I know very little about VBA, but after some internet research and using the Record Macro function I managed to piece together code that: copies cells from EE Attendance Calendar and pastes them into a different sheet in a new workbook, completes some formatting, enters formulas into certain cells, saves the new workbook, emails it to the employee, and then deletes the new workbook.
The part I'm have a problem with is doing all the above for each employee in the Data Validation list with one click of a button. I found this thread with a seemingly similar question:
http://www.ozgrid.com/forum/sh…highlight=validation+list
I tried to insert the suggested code in my code, but I'm not getting the desired result. When I run the macro, it creates the new file and sends the email for the first employee listed over and over again. I’m pretty sure it would go all day long if I let it. I end up having to use Task Manager to kill Excel. Not sure if I'm not inserting the code in the proper place or if my situation requires different code to handle looping through the names on the list.
I also found this thread, but I’m not sure how to incorporate the code.
http://www.ozgrid.com/forum/sh…ighlight=macro+validation
My code where I tried to incorporate the code in the first thread is below. I can upload the workbook, but I will need to delete employee data. So, thought I would try this way first.
Let me know if you need any additional information. Your guidance is greatly appreciated!
Option Explicit
Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "C:\Users\Julie\Documents\Attachments"
Const stSubject As String = "Days Off Request Report"
Const vaMsg As Variant = "Please find attached your Days Off Request Report. The report documents requests submitted to date for vacation, personal holiday, and disability days. It also shows your remaining vacation and personal holiday balance." & vbCrLf & _
"" & vbCrLf & _
"Let me know if you have any questions or concerns." & vbCrLf & _
"" & vbCrLf & _
"Julie"
Sub Send_All_Active_Sheet()
Dim stFileName As String
Dim vaRecipients As Variant
Dim strdate As String
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String
Dim source As Range
Dim ColumnCount As Long
Dim FirstColumn As Long
Dim ColumnWidthArray() As Double
Dim lIndex As Long
Dim lCount As Long
Dim dest As Workbook
Dim i As Long
Dim dvCell As Range
Dim inputRange As Range
Dim c As Range
'Which cell has data validation
Set dvCell = Worksheets("EE Attendance Calendar").Range("A4")
'Determine where validation comes from
Set inputRange = Evaluate(dvCell.Validation.Formula1)
i = 1
'Begin our loop
Application.ScreenUpdating = False
For Each c In inputRange
'Select range of cells, copy and paste into temporary workbook.
Set source = Nothing
On Error Resume Next
Set source = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
Set source = Range("A1:AI24").SpecialCells(xlCellTypeVisible)
Range("A1:AI24").Select
Application.ScreenUpdating = False
ColumnCount = Selection.Columns.Count
FirstColumn = Selection.Cells(1).Column - 1
ReDim ColumnWidthArray(1 To ColumnCount)
lIndex = 0
For lCount = 1 To ColumnCount
If Columns(FirstColumn + lCount).Hidden = False Then
lIndex = lIndex + 1
ColumnWidthArray(lIndex) = Columns(FirstColumn + lCount).ColumnWidth
End If
Next lCount
Set dest = Workbooks.Add(xlWBATWorksheet)
source.Copy
With dest.Sheets(1)
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
For i = 1 To lIndex
.Columns(i).ColumnWidth = ColumnWidthArray(i)
Next
Rows("1").Select
Selection.RowHeight = 18
Range("2:2,5:5,19:23").Select
Selection.RowHeight = 15
Rows("3").Select
Selection.RowHeight = 12
Rows("4").Select
Selection.RowHeight = 14.25
Rows("6:18").Select
Selection.RowHeight = 27
Range("AG7").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(RC2:RC32,""V"")+((COUNTIF(RC2:RC32,""HV""))/2)"
Range("AG7").Select
Selection.AutoFill Destination:=Range("AG7:AG18"), Type:=xlFillDefault
Range("AG7:AG18").Select
Range("AG8,AG10,AG12,AG14,AG16,AG18").Select
Range("AG18").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16510681
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("AH7").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(RC2:RC32,""P"")+((COUNTIF(RC2:RC32,""HP""))/2)"
Range("AH7").Select
Selection.AutoFill Destination:=Range("AH7:AH18"), Type:=xlFillDefault
Range("AH7:AH18").Select
Range("AH8,AH10,AH12,AH14,AH16,AH18").Select
Range("AH18").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16510681
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("AI7").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(RC2:RC32,""D"")+((COUNTIF(RC2:RC32,""HD""))/2)"
Range("AI7").Select
Selection.AutoFill Destination:=Range("AI7:AI18"), Type:=xlFillDefault
Range("AI7:AI18").Select
Range("AI8,AI10,AI12,AI14,AI16,AI18").Select
Range("AI18").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16510681
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("AG20").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-2]C)"
Range("AH20").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-2]C)"
Range("AI20").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-2]C)"
Range("AG21").Select
ActiveCell.FormulaR1C1 = "=R[-2]C-R[-1]C"
Range("AH21").Select
ActiveCell.FormulaR1C1 = "=R[-2]C-R[-1]C"
Range("A25").Select
ActiveWindow.DisplayGridlines = False
End With
'Set page orientation & scale.
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.FitToPagesWide = 1
End With
Application.PrintCommunication = True
'Save and close the temporary workbook.
strdate = Format(Now, "mm-dd-yy")
stAttachment = stPath & "\" & "Days Off Request Report " & strdate & ".xlsx"
With ActiveWorkbook
.SaveAs stAttachment
.Close
End With
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'Add values to the created e-mail main properties.
vaRecipients = ThisWorkbook.Sheets("EE Attendance Calendar").Range("AN6").Value
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
End With
'Delete the temporary workbook.
Kill stAttachment
'Send the e-mail.
On Error Resume Next
With noDocument
.PostedDate = Now()
.Send 0, vaRecipients
End With
'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
'Go to next name on Date Validation list
Next c
Application.ScreenUpdating = True
End Sub