Thread: email to notify or display a list of discrepancies / expirations

Hi, what i'm looking for is very similar to this thread: http://www.excelforum.com/excel-prog...piry-date.html

EDIT: my latest code and spreadsheet are on post #9

Basically, we keep a spreadsheet of our contractors/subcontractors on file so that we can make sure that we aren't contracting with someone that either 1. doesn't have a business license, or 2. lets their insurance / business license expire.

i've attached a 'dumbed-down' version of my spreadsheet with actual expiration dates, my question is;

to remain compliant, we need to make sure that all of our contractors'/subcontractors' insurance/business licenses are current... what I'm thinking is a set of 'buttons' to run the report for a couple different things, OR 1 button to do everything. Basically, if a discrepancy is found (which would be determined if today's date is within X amount or past the date in a given cell), it would either display that information on a [separate] sheet or shoot an email to the master contractor or an email specified in a cell.. now these spreadsheets are always changing, we lose/gain new contractors constantly..

the email or list of discrepancies would have to include the entire row and possibly the header row so that the person viewing it would be able to see what the expiration dates are for..

is this possible? the reason i'm working on this is because a friend of mine is responsible for notifying the appropriate people of upcoming expirations and lately, she hasn't been able to keep up so I want to make sure her job is secure..

so i know i can put in each separate cell via

" & .Cells(i, 1).Value & _
                    "

but is there a way to just include the entire row?

so instead of including the entire row, i just changed it to:

                    "... Contractor Details: Driver Number: " & .Cells(i, 1).Value & _
                    ", Driver Name: " & .Cells(i, 2).Value & _
                    ", COI Expires on: " & .Cells(i, 5).Value & _
                    ", Cargo expires on: " & .Cells(i, 6).Value & _
                    ", Additional Comments: " & .Cells(i, 8).Value & _
                    vbCrLf & vbCrLf & "Thank you."

to just grab the bits i need, so no need to answer that question any more.. however, i still have no answer as to if i could just have 1 button run all the commands that i currently have 4 buttons doing?

edit: also, since i have multiple sheets per excel file, is it possible to have a button for each sheet to "SEND ALL DISCREPANCY EMAILS" from the first sheet in the excel file?

all help is appreciated, i'm sure i will eventually get it by myself but it doesnt mean i cant ask for help, right? thanks.

Hi mrmarchuk
Been following your Thread...you seem to be making significant progress. If you'd like personalized help, please post your file (proprietary info modified) along with your existing code and an explanation of what you'd like to happen.

For now, i have the code as such:

Private Sub CommandButton1_Click()
    Dim ce As Range, i As Long
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String

    For i = 2 To Sheets("Sheet1").Range("B65536").End(xlUp).Row
        If Cells(i, 5).Value <= (Date + 30) Then
            Set OutApp = CreateObject("Outlook.Application")
            OutApp.Session.Logon
            Set OutMail = OutApp.CreateItem(0)
        
            With Sheets("Sheet1")
                strto = .Cells(i, 11).Value
                strcc = .Cells(i, 12).Value
                strbcc = ""
                strsub = "Insurance Compliance"
                strbody = "Hi there" & vbNewLine & vbNewLine & _
                    "The Certificate of Insurance for Contractor" & .Cells(i, 1).Value & _
                    ", " & .Cells(i, 2).Value & _
                    ", is due to expire on " & .Cells(i, 5).Value & _
                    ". Please provide Vendor Relations with an updated Cargo Insurance before date of expiration to remain Compliant." & _
                    "... SP Details: Driver Number: " & .Cells(i, 1).Value & _
                    ", Driver Name: " & .Cells(i, 2).Value & _
                    ", COI Expires on: " & .Cells(i, 5).Value & _
                    ", Cargo expires on: " & .Cells(i, 6).Value & _
                    ", Additional Comments: " & .Cells(i, 8).Value & _
                    vbCrLf & vbCrLf & "Thank you."
            End With
    
            With OutMail
                .To = strto
                .CC = strcc
                .BCC = strbcc
                .Subject = strsub
                .Body = strbody
                .Send
            End With
    
            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
    Next i
End Sub


Private Sub CommandButton2_Click()
    Dim ce As Range, i As Long
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String

    For i = 2 To Sheets("Sheet1").Range("B65536").End(xlUp).Row
        If Cells(i, 6).Value <= (Date + 30) Then
            Set OutApp = CreateObject("Outlook.Application")
            OutApp.Session.Logon
            Set OutMail = OutApp.CreateItem(0)
        
            With Sheets("Sheet1")
                strto = .Cells(i, 11).Value
                strcc = .Cells(i, 12).Value
                strbcc = ""
                strsub = "Cargo Insurance Compliance"
                strbody = "Hi there" & vbNewLine & vbNewLine & _
                    "The Cargo Insurance for Contractor" & .Cells(i, 1).Value & _
                    ", " & .Cells(i, 2).Value & _
                    ", is due to expire on " & .Cells(i, 6).Value & _
                    ". Please provide Vendor Relations with an updated Cargo Insurance before date of expiration to remain Compliant." & _
                    "... SP Details: Driver Number: " & .Cells(i, 1).Value & _
                    ", Driver Name: " & .Cells(i, 2).Value & _
                    ", COI Expires on: " & .Cells(i, 5).Value & _
                    ", Cargo expires on: " & .Cells(i, 6).Value & _
                    ", Additional Comments: " & .Cells(i, 8).Value & _
                    vbCrLf & vbCrLf & "Thank you."
                End With
    
            With OutMail
                .To = strto
                .CC = strcc
                .BCC = strbcc
                .Subject = strsub
                .Body = strbody
                .Send
            End With
    
            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
    Next i
End Sub


Private Sub CommandButton3_Click()
    Dim ce As Range, i As Long
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String

    For i = 2 To Sheets("Sheet1").Range("B65536").End(xlUp).Row
        If Cells(i, 7).Value <= (Date + 30) Then
            Set OutApp = CreateObject("Outlook.Application")
            OutApp.Session.Logon
            Set OutMail = OutApp.CreateItem(0)
        
            With Sheets("Sheet1")
                strto = .Cells(i, 11).Value
                strcc = .Cells(i, 12).Value
                strbcc = ""
                strsub = "ENOL Compliance"
                strbody = "Hi there" & vbNewLine & vbNewLine & _
                    "The Employee Non-Owned liability insurance for Contractor" & .Cells(i, 1).Value & _
                    ", " & .Cells(i, 2).Value & _
                    ", is due to expire on " & .Cells(i, 7).Value & _
                    ". Please provide Vendor Relations with an updated Certificate of ENOL Insurance before date of expiration to remain Compliant." & _
                    "... SP Details: Driver Number: " & .Cells(i, 1).Value & _
                    ", Driver Name: " & .Cells(i, 2).Value & _
                    ", COI Expires on: " & .Cells(i, 5).Value & _
                    ", Cargo expires on: " & .Cells(i, 6).Value & _
                    ", Additional Comments: " & .Cells(i, 8).Value & _
                    vbCrLf & vbCrLf & "Thank you."
            End With
    
            With OutMail
                .To = strto
                .CC = strcc
                .BCC = strbcc
                .Subject = strsub
                .Body = strbody
                .Send
            End With
    
            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
    Next i
End Sub



Private Sub CommandButton4_Click()
    Dim ce As Range, i As Long
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String

    For i = 2 To Sheets("Sheet1").Range("B65536").End(xlUp).Row
        If Cells(i, 10).Value <= (Date + 30) Then
            Set OutApp = CreateObject("Outlook.Application")
            OutApp.Session.Logon
            Set OutMail = OutApp.CreateItem(0)
        
            With Sheets("Sheet1")
                strto = .Cells(i, 11).Value
                strcc = .Cells(i, 12).Value
                strbcc = ""
                strsub = "Business License Compliance"
                strbody = "Hi there" & vbNewLine & vbNewLine & _
                    "The Business License for Contractor" & .Cells(i, 1).Value & _
                    ", " & .Cells(i, 2).Value & _
                    ", is due to expire soon. Please provide Vendor Relations with an Certificate by " & .Cells(i, 10).Value & _
                    " to remain compliant." & _
                    "... SP Details: Driver Number: " & .Cells(i, 1).Value & _
                    ", Driver Name: " & .Cells(i, 2).Value & _
                    ", COI Expires on: " & .Cells(i, 5).Value & _
                    ", Cargo expires on: " & .Cells(i, 6).Value & _
                    ", Additional Comments: " & .Cells(i, 8).Value & _
                    vbCrLf & vbCrLf & "Thank you."
                End With
    
            With OutMail
                .To = strto
                .CC = strcc
                .BCC = strbcc
                .Subject = strsub
                .Body = strbody
                .Send
            End With
    
            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
    Next i
End Sub

The problem is, We keep track of 2200 contractors (you'd think the company would have thought of this by now, huh?)

anyways, we have 4 such excel files, each containing an average of 5 sheets with an average of 110 contractors per sheet.. what i have managed to piece together so far Saves ALOT of time but if i could get it to where i can just open up the spreadsheet and on the first sheet, have the button/s to run the commands, that would save even more time! now, i'm pretty sure 1 button per sheet is possible but is it possible to link each sheet to 1 "MASTER BUTTON"? if not, can someone help me compile 1 button to do what currently, my 4 buttons do?

Hi mrmarchuk

So, as I understand it, you'd like to send emails based on Insurance Expiration Date, Cargo Insurance Expiration Date, ENOL Insurance and Business License Expiration Date for each sheet in the workbook (perhaps 5 or more worksheets) with the click of one button. Correct so far?

If correct, what about the other workbooks? You want the same capability? Or do you want one button that'll cycle through ALL the worksheets in ALL the workbooks and send ALL the emails for ALL worksheets in ALL workbooks?

Originally Posted by jaslake

Hi mrmarchuk

So, as I understand it, you'd like to send emails based on Insurance Expiration Date, Cargo Insurance Expiration Date, ENOL Insurance and Business License Expiration Date for each sheet in the workbook (perhaps 5 or more worksheets) with the click of one button. Correct so far?

If correct, what about the other workbooks? You want the same capability? Or do you want one button that'll cycle through ALL the worksheets in ALL the workbooks and send ALL the emails for ALL worksheets in ALL workbooks?

if it's possible to get one button to cycle through all the workbooks, that would be amazing, however, 1 button in each workbook cycling through all the worksheets is what i was originally going for


how it works is 1 person updates all of the workbooks (1 workbook=1 region, each worksheet is a separate office within the region) each sheet has it's own admin who's supposed to keep track of the expiration's, but almost no-one does, which is why i wanted this email function.. Basically, if i could get 1 button per worksheet. i realize i havent done this until now but i've constructed a spreadsheet more-or-less how it looks for us and attached it to this post:

newest workbook as of 2/9/11, now that i have it in sheets, it gives me a runtime error ('-2147467259 (80004005)) and says there must be at least one name or distribution list int he to, CC, or BCC box.. but it's weird, because i HAVE the email addresses in the cells, and it sends the email out after that error pops up, the only difference is, now it doesnt ASK Outlook for permission... :

discrepancy workbook with runtime error.2.8.12.xlsm

more or less the same thing, just with the main page how and with the worksheets (facilities) there as well.. 1 button on each "SUMMARY" page would actually probably be best, that way if another facility is added, that can be added to the code, and will keep it much simpler, in my opinion

thanks again for your help Jaslake

edit: even if 1 button were to 'push' the existing buttons, that would be alright that might actually even be better since if there's an error with 1 button, the others will still more-or-less work

Hi mrmarchuk
Well, this is good

now it doesn't ASK Outlook for permission

It's my experience that doesn't happen in Excel/Outlook 2007. You're profile indicates Excel 2003 yet you uploaded an .xlsm file. So, what version(s) are we developing for?

Please don't shout...it's distracting.

sorry I didn't set it right when i set up my profile.. I'm using office 2007

edit: updated the workbook in post #9, removed my email address :P

Hi Sergey
I've added a UserForm and a Button to Summary sheet that will allow you to select 1 or more Facilities to process all Command Buttons of 1 or all Facilities.

You'll need to change some things in each worksheet (I've already done so for Facility1 and Facility2).
You need to change the CommandButton_Click event from Private to Public for each CommandButton_Click event (look at the code for Facility1 and you'll see what I mean).
Also, to eliminate the runtime error, you need to redirect this line of code in all CommandButton_Click events

For i = 2 To Sheets("Facility3").Range("B65536").End(xlUp).Row

In Facility1 and Facility2, I've arbitrarily changed it to

For i = 2 To Sheets("Facility1").Range("C65536").End(xlUp).Row

You have data in Column B below the range of cells being processed...ergo, the runtime error.

Let me know of issues.

Hi Sergey
Done, as you requested

in the attachment you posted, please remove the emails

If that satisfies your need, I'd appreciate it if you'll please mark your thread as "Solved".

To mark your thread solved do the following:
- Go to your first post on the thread
- Click edit
- Click Advance
- Just below the word "Title:" you will see a dropdown with the word No prefix.
- Change to Solved
- Click Save