Solved

Excel 2010:  Macro that will Inform others of any updates Done

Posted on 2013-01-31
14
266 Views
Last Modified: 2013-02-06
ello Experts,

    I have a workbook that consists of 4 worksheets.  I'm curious if anyone has a macro that will notify others of any updates that are done on any worksheets in a workbook.  Just a quick notification email saying "An entry as added to such and such on such and such date"  

    What would be perfect is after an entry as made to the worksheet, you could then press a control button to invoke the macro.  A window would then pop up asking "How many entries where made to worksheet (type in name of worksheet)?"  You'd then enter that number and click OK.  It would then send an email to notifying others that an entry was made with the spiel above:  

""An entry as added to <worksheet name> on such on such date"

Much thanks for any help or suggestions on this!
0
Comment
Question by:itsmevic
  • 7
  • 5
  • 2
14 Comments
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 38843154
yes, you can use the worksheet_change event to take note of any changes.

then on the workbook_close event, you could send the email to desired list of users,

see http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27907980.html for much of the code.
0
 
LVL 14

Expert Comment

by:Faustulus
ID: 38844587
I wonder if it wouldn't be possible to fully automate this process:-
Count the number of rows when the workbook is opened and when it is saved. If there is a difference send an email where the difference is the number of rows added.
Note that it doesn't matter how many rows the user adds. Action is only taken based on what he saves. The Save command replaces the button you were imagining.
In order to realize this idea you would need to confirm that new items are indeed added on one worksheet whose rows can be counted. If it is more complicated to count or several worksheets to watch I would need a mockup of the workbook.
The other issue is the method of sending the email. If the mail is to be sent directly you need access to the SMPT server. Do you have that? Else, if you prefer to put the mail in the outbox of a client, for example Outlook, I would need to know which client you are using.
0
 
LVL 32

Assisted Solution

by:Robberbaron (robr)
Robberbaron (robr) earned 500 total points
ID: 38846261
in ThisWorkbook object...
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'show how many rows were changed
    x = MsgBox(DisplayResponse(Me), vbInformation + vbOKOnly)
      
    Exit Sub  'remove when happy working
    
    SendMailOutlook "you@somewhere", "Workbook " & Me.Name & " has been edited", DisplayResponse(Me)
End Sub

Open in new window


in each worksheet object (ie Sheet1, Sheet2 etc)
Private Sub Worksheet_Change(ByVal Target As Range)
    AddRowChange Me, Target.Row
End Sub

Open in new window


in a code module,,,
Private changedRows As Collection

Public Sub AddRowChange(wks As Worksheet, rownum As Long)
    Dim thiskey As String
    thiskey = wks.Name & "#" & Format(rownum, "0")
    
    If Not InCollection(changedRows, thiskey) Then
        changedRows.Add thiskey, thiskey
    End If
End Sub

Public Function DisplayResponse(wb As Workbook)
    Dim wks As Worksheet, outD As String
    Dim rowcount As Long
    Dim itx As Variant
    For Each wks In wb.Sheets
        rowcount = 0
        thiskey = wks.Name & "#"
        For Each itx In changedRows
            If InStr(itx, thiskey) Then
                rowcount = rowcount + 1
            End If
        Next itx
        outD = outD & "Worksheet " & wks.Name & " :: " & Format(rowcount, "0") & " changes" & vbCrLf
    Next wks
    DisplayResponse = outD
End Function
Public Function InCollection(col As Collection, key As String) As Boolean
   'http://stackoverflow.com/questions/137845/determining-whether-an-object-is-a-member-of-a-collection-in-vba
   
    Dim var As Variant
    Dim errNumber As Long
    
    InCollection = False
    Set var = Nothing
    
    Err.Clear
    On Error Resume Next
      var = col.Item(key)
      errNumber = CLng(Err.Number)
    On Error GoTo 0
    
'5 if not in collection, it is 91 if no collection exists
    If errNumber = 5 Then
        InCollection = False
    ElseIf errNumber = 91 Then
        InCollection = False
        Set col = New Collection
    Else
      InCollection = True
    End If

End Function

Sub SendMailOutlook(sTo, sSubject, sBody)

    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    With OutMail
        .To = sTo
        .CC = ""
        .Subject = sSubject
        .Body = sBody
        '.Attachments.Add ActiveWorkbook.FullName
        .Send
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Open in new window

trackupdates.xlsm
0
 
LVL 14

Expert Comment

by:Faustulus
ID: 38847821
robberbaron,
You didn't get the idea quite right. Using the Before_Close event is different from using the Workbook_Save event. Your construct will allow the user to cause an email to be sent advising of items added which were never saved.
0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 38847872
true enough.  i used close event in my testing as i was saving updates as i went.
0
 

Author Comment

by:itsmevic
ID: 38853030
Robberbaron, I like the way the spreadsheet is able to determine how many changes where done per worksheet.  Very nice.  Does this code need to be adjusted to show to "workbook_save' rather then "before_close" ?  

    Presently, with what we have now, I'll make my changes, click Save, and, exit out, but will be prompted with how many changes where made on what sheet.  I would assume at that point an email is sent out from the email addy listed in "This Workbook" and the To:  in the module code.  I adjusted it from myself to myself and haven't received anything as a test yet.  Perhaps I'm not doing something correctly?
0
 
LVL 32

Assisted Solution

by:Robberbaron (robr)
Robberbaron (robr) earned 500 total points
ID: 38853211
1.1/ I avoided using the WorkBook_Save as if the user saves the document 3 times while working on it, 3 meesages would be sent.
1.2/  Faustulus comment is useful as the Before_Close can be considerably improved by  
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'only send mail if workbook changes saved.
    If Me.Saved Then
        'show how many rows were changed
        x = MsgBox(DisplayResponse(Me), vbInformation + vbOKOnly)
                
        SendMailOutlook "you@somewhere", "Workbook " & Me.Name & " has been edited", DisplayResponse(Me)
    End If
End Sub

Open in new window


1.3/ note this may still need improvement as if the user saves document, makes further changes, and then quits without saving, the message wont be sent.
perhaps this is better.... not tested though.
Private WasSaved As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'only send mail if workbook changes saved.
    If WasSaved Then
        'show how many rows were changed
        x = MsgBox(DisplayResponse(Me), vbInformation + vbOKOnly)
                
        SendMailOutlook "you@somewhere", "Workbook " & Me.Name & " has been edited", DisplayResponse(Me)
    End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    WasSaved = True
End Sub

Open in new window



2/ my code was for testing and had
Exit Sub
before the SendMailOutlook line so it never got to actually send the mail, just show the message.  You may want to comment out the MsgBox line when happy with process.
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 32

Assisted Solution

by:Robberbaron (robr)
Robberbaron (robr) earned 500 total points
ID: 38853220
possible further improvement....  Note that Workbook.AfterSave has been added to Excel2010+. ( ihave XL2007)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    'http://www.vbforums.com/showthread.php?524692-aftersave-event-in-VB-excel
    Cancel = True 'cancels the users original save command request
    Application.EnableEvents = False 'stops beforesave event from re-running
    If (SaveAsUI) Then
        'ActiveWorkbook.SaveAs - Don't use it; without parms it will just do a Save.
        Application.Dialogs(xlDialogSaveAs).Show 'This works.
    Else
        ActiveWorkbook.Save 'saves workbook just like user wanted
    End If
    Application.EnableEvents = True
    If ActiveWorkbook.Saved Then
        WasSaved = True
    End If
End Sub

Open in new window

0
 

Author Comment

by:itsmevic
ID: 38853337
Ok so the revised code is as such:

Under "ThisWorkbook"
Private WasSaved As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'only send mail if workbook changes saved.
    If WasSaved Then
        'show how many rows were changed
        'x = MsgBox(DisplayResponse(Me), vbInformation + vbOKOnly)
                
        SendMailOutlook "johndoe@abc.com", "Workbook " & Me.Name & " has been edited", DisplayResponse(Me)
    End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    'http://www.vbforums.com/showthread.php?524692-aftersave-event-in-VB-excel
    Cancel = True 'cancels the users original save command request
    Application.EnableEvents = False 'stops beforesave event from re-running
    If (SaveAsUI) Then
        'ActiveWorkbook.SaveAs - Don't use it; without parms it will just do a Save.
        Application.Dialogs(xlDialogSaveAs).Show 'This works.
    Else
        ActiveWorkbook.Save 'saves workbook just like user wanted
    End If
    Application.EnableEvents = True
    If ActiveWorkbook.Saved Then
        WasSaved = True
    End If
End Sub

Open in new window


For each of my sheets (Sheet 1 thru Sheet 6):
Private Sub Worksheet_Change(ByVal Target As Range)
    AddRowChange Me, Target.Row
End Sub

Open in new window


For the Module code:
Private changedRows As Collection

Public Sub AddRowChange(wks As Worksheet, rownum As Long)
    Dim thiskey As String
    thiskey = wks.Name & "#" & Format(rownum, "0")
    
    If Not InCollection(changedRows, thiskey) Then
        changedRows.Add thiskey, thiskey
    End If
End Sub

Public Function DisplayResponse(wb As Workbook)
    Dim wks As Worksheet, outD As String
    Dim rowcount As Long
    Dim itx As Variant
    For Each wks In wb.Sheets
        rowcount = 0
        thiskey = wks.Name & "#"
        For Each itx In changedRows
            If InStr(itx, thiskey) Then
                rowcount = rowcount + 1
            End If
        Next itx
        outD = outD & "Worksheet " & wks.Name & " :: " & Format(rowcount, "0") & " changes" & vbCrLf
    Next wks
    DisplayResponse = outD
End Function
Public Function InCollection(col As Collection, key As String) As Boolean
   'http://stackoverflow.com/questions/137845/determining-whether-an-object-is-a-member-of-a-collection-in-vba
   
    Dim var As Variant
    Dim errNumber As Long
    
    InCollection = False
    Set var = Nothing
    
    Err.Clear
    On Error Resume Next
      var = col.Item(key)
      errNumber = CLng(Err.Number)
    On Error GoTo 0
    
'5 if not in collection, it is 91 if no collection exists
    If errNumber = 5 Then
        InCollection = False
    ElseIf errNumber = 91 Then
        InCollection = False
        Set col = New Collection
    Else
      InCollection = True
    End If

End Function
Sub SendMailOutlook(sTo, sSubject, sBody)

    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    With OutMail
        .To = sTo
        .CC = ""
        .Subject = sSubject
        .Body = sBody
        '.Attachments.Add ActiveWorkbook.FullName
        .Send
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Open in new window

0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 38853615
looks right but  I cant test till tonight.
0
 

Author Comment

by:itsmevic
ID: 38855424
I just tested it, it appears to be choking when trying to close out of the document.  Goes into Debug and highlights what I have bolded below.
*******************************
"Compile error:
User-defined type not defined"
                                              OK     Help
*******************************

I click OK and it takes me to this part of the code:

Sub SendMailOutlook(sTo, sSubject, sBody)

    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    With OutMail
        .To = sTo
        .CC = ""
        .Subject = sSubject
        .Body = sBody
        '.Attachments.Add ActiveWorkbook.FullName
        .Send
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
0
 
LVL 32

Accepted Solution

by:
Robberbaron (robr) earned 500 total points
ID: 38857469
you need to add a reference to the Outlook Outlook Object Library

in VB window, Tools , References. Find and tick the objetc from available list.


if you dont have outlook installed locally, you need to use one of the other methods in the previous question i linked to. (SMTP or GMail)

The macro keeps prompting for save in my test as well. just select NO.
0
 

Author Comment

by:itsmevic
ID: 38859860
Went back in and copied your first email function back into the code and for some reason it is now emailing a notification.  Weird.  LOL
0
 

Author Closing Comment

by:itsmevic
ID: 38860073
Fantastic input, thank you!
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now