I am trying to work out VBA code to do the following,
- Select Sheet “ABL”
- Row 10 has headings (column A to N)
- Sort data by Alphabet in Column H – values Critical, High, Medium and Low – Filters are on.
- Select all rows with Critical and High value in Column H.
- Copy this data.
- Select sheet “DBL” – Row 46 has headings and formats, same as of sheet ABL
- Clear all the rows from 47 onwards in sheet DBL – Row 1 – 46 has some graphs.
- Paste the data into DBL from row 47 onwards which was copied from sheet ABL with High and Critical Values (column H). Format must be same.
- Convert DBL into pdf – only rows with data.
- Email this pdf using tbl_Main_Email_List as To: and tbl_CC_Email_list as CC:.
I have worked out a code to do above but main issues are,
- Data will vary from week to week i.e. one week it may only have 5 rows with High and Critical and next week it may have 10, week after maybe 2.
- When the data is pasted into sheet DBL, it does not copy the borders.
Code is pasted below, it does not contain data sort, copy and paste information. It does contain some MsgBox Input which I would like to retain.
Sub Email() Application.ScreenUpdating = False Sheets("DBL").Select Dim AlertInput As String AlertInput = InputBox("What is the Subject of Email?", "ABC - Project Dashboard Summary") If AlertInput = vbNullString Then MsgBox ("This Email request has been cancelled...") Else Dim v As Variant v = Environ("Temp") & "\DBL_Summary.pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=v Dim toRange As Range Dim ccRange As Range Dim cl As Range Dim toList As String Dim ccList As String Dim toListCnt As Long Dim ccListCnt As Long With Worksheets("Email.List") Set toRange = .Range("A3", .Range("A3").End(xlDown)) toListCnt = WorksheetFunction.CountA(toRange) Set ccRange = .Range("B3", .Range("B3").End(xlDown)) ccListCnt = WorksheetFunction.CountA(ccRange) 'MsgBox toListCnt End With 'add main recipients to toList string For Each cl In toRange If toListCnt = 1 Then toList = toList & cl.Value Exit For End If toList = toList & "; " & cl.Value Next cl 'add cc recipients to ccList string For Each cl In ccRange If ccListCnt = 1 Then ccList = ccList & cl.Value Exit For End If ccList = ccList & "; " & cl.Value Next cl 'MsgBox toList On Error Resume Next With CreateObject("Outlook.Application").CreateItem(0) .To = toList .Cc = ccList .Subject = "Weekly DBL Summary - " & AlertInput .Body = "" .Attachments.Add v .display End With On Error GoTo 0 Kill v End If Application.ScreenUpdating = True End Sub
Apologies if it has been requested before but I could not find any specific reference. Any help in above will be appreciated.