Alternatively you can use the SaveAs to create passwords to prevent editing. The other arguments of the SaveAs code are at: https://msdn.microsoft.com/en-…kbook-saveas-method-excel
Posts by Trevor_S
Please note that on 14th December 2023 users will experience an expected outage whilst we make upgrades to our network. We anticipate this process may take a couple of hours and so we apologise in advance for any inconvenience.
-
-
-
Re: Copying Data from Multiple Workbooks to a Master Workbook
It may be the fact that its a Mac, I think (from other forum posts) there are differences in coding between the two. Do you have access to a Windows PC that you could try it on? Unfortunately I don't have a Mac.
-
Re: Copying Data from Multiple Workbooks to a Master Workbook
Its right near the beginning. When you run the macro, a window should appear that will let you select a folder.
Are you getting that window? If so, add a line at the end of that block, before the 'Settings block:
This should display the full path for the folder that you have selected in a message box.
If that's not working, try removing the whole 'Get folder containing files block, and replace it with a line with the filepath hardcoded like this:
Remember to include the final \ -
-
Re: Trigger needed
Yes, you can.
-
Re: Trigger needed
It should run automatically as soon as the spreadsheet opens, provided that it is in the "ThisWorkbook" in VBA - which is immediately below the list of sheets (i.e. not in a module).
-
Re: Trigger needed
This is the line of code that should pick up the name:
mymsg = mymsg & "<TD>" & ActiveSheet.Cells(cell.Row, 2).Value & "</TD>The 2 represents the number of the column that its looking for the name in - i.e. column B. Is that where the name is? If the name is in column A, change the 2 in this code line to a 1.
-
Re: Trigger needed
That normally only appears when it can't find a macro. Could you please upload a copy of the spreadsheet? You can blank out the data if you want, its just so I can see how/where the macro appears.
-
-
-
Re: Trigger needed
I have made the changes - here is the revised code:
Code
Display MorePrivate Sub Workbook_Open() If Application.WorksheetFunction.COUNTIF(ActiveSheet.Range("E:BS"), "DUE") > 0 Then mymsg = "≪HTML≫≪Body≫Good Morning≪p≫Please find below the staff that are due reassessment and the given module in question." mymsg = mymsg & "≪Table≫≪TR≫" mymsg = mymsg & "≪TD≫≪STRONG≫Name≪/STRONG≫≪/TD≫" mymsg = mymsg & "≪TD≫≪STRONG≫Module≪/STRONG≫≪/TD≫" mymsg = mymsg & "≪/TR≫" LastRow = ActiveSheet.Range("A1").End(xlDown).Row For Each cell In ActiveSheet.Range("A1:BS" & LastRow) If cell.Value = "DUE" Then mymsg = mymsg & "≪TR≫" mymsg = mymsg & "≪TD≫" & ActiveSheet.Cells(cell.Row, 2).Value & "≪/TD≫" mymsg = mymsg & "≪TD≫" & ActiveSheet.Cells(1, cell.Column - 1).Value & "≪/TD≫" mymsg = mymsg & "≪/TR≫" End If Next mymsg = mymsg & "≪/TABLE≫≪/Body≫≪/HTML≫" Dim olApp As Outlook.Application Dim objMail As Outlook.MailItem Set olApp = Outlook.Application Set objMail = olApp.CreateItem(olMailItem) With objMail .BodyFormat = olFormatHTML .HTMLBody = mymsg .To = "[email protected]" 'Put recipient email address here .Send End With End If End Sub
It should go into the ThisWorkbook section of the VBA Project. I have created and attached a spreadsheet based on your original sample, with the macro added in the correct place, in case it helps: forum.ozgrid.com/index.php?attachment/72179/
Bear in mind that if you download and open it with macros enabled, it should try to send an email as soon as you open it. You should still get a message box notifying you of this, and you can just click the option to disallow so that nothing is sent ... or better still, disable macros in excel before opening it.I haven't been able to fully test it, as I don't have Outlook. It may error on the line .BodyFormat = olFormatHTML - if so, delete that line and it should work fine.
A few other points to note:- As previously, replace the double greater than and less than symbols with single ones. The uploaded excel spreadsheet linked to above shows the symbols correctly.
- I'm assuming that there will be no gaps in data in column A. The macro only searches until it gets to the bottom of a continuous block of data in column A, to prevent it searching thousands of blank rows.
- I'm also assuming that either this is the only sheet in the workbook, or if not, it will be the active workbook at the time that it is opened. If this may not be the case, add a line like this directly below Private Sub Workbook_Open() in order to make it the active sheet:
As for your question about me, I've just picked up what I know from having used Excel for over 20 years for accountancy work. There's always more to learn and better ways to do things. I've gained a lot over the years from searching various forums, and so now also try to answer what I can. In particular, I try to find questions that have gone unanswered for a while, as there's a risk that once they disappear from the New Posts lists, they don't get spotted so easily.Anyway, hope that this does what you need!
-
Re: Trigger needed
Sorry for the delay ... it can be done (although the extra searching may slow it down a bit). But the other part of my question was what do you want to be displayed in the email? At the moment it checks column E and where DUE is found, it displays A:D in the email. But what if DUE was found in column AA? Presumably the contents of columns C and D would be irrelevant?
If you only want columns A and B in the email, the amended code is below (note that there's the same issue with double << and >> symbols). But if you want any other columns displayed, let me know.
Code
Display MorePrivate Sub Workbook_Open() If Application.WorksheetFunction.COUNTIF(ActiveSheet.Range("E:BS"), "DUE") > 0 Then mymsg = "≪HTML≫≪Body≫Text to appear before table" mymsg = mymsg & "≪Table≫≪TR≫" mymsg = mymsg & "≪TD≫" & ActiveSheet.Cells(1, 1).Value & "≪/TD≫" mymsg = mymsg & "≪TD≫" & ActiveSheet.Cells(1, 2).Value & "≪/TD≫" mymsg = mymsg & "≪/TR≫" LastRow = ActiveSheet.Range("A1").End(xlDown).Row For Each cell In ActiveSheet.Range("A1:BS" & LastRow) If cell.Value = "DUE" Then mymsg = mymsg & "≪TR≫" mymsg = mymsg & "≪TD≫" & ActiveSheet.Cells(cell.Row, 1).Value & "≪/TD≫" mymsg = mymsg & "≪TD≫" & ActiveSheet.Cells(cell.Row, 2).Value & "≪/TD≫" mymsg = mymsg & "≪/TR≫" End If Next mymsg = mymsg & "≪/TABLE≫≪/Body≫≪/HTML≫" Dim olApp As Outlook.Application Dim objMail As Outlook.MailItem Set olApp = Outlook.Application Set objMail = olApp.CreateItem(olMailItem) With objMail .BodyFormat = olFormatHTML .HTMLBody = mymsg .To = "[email protected]" 'Put recipient email address here .Send End With End If End Sub
-
Re: Trigger needed
You are right that its currently just checking column E. Its also only putting values from columns A to D into the email. From your extract, I'm assuming that columns C and D only make sense to be reported in the email if "DUE" was found in column E. Therefore could you clarify which column(s) should be reported in the email, and I'll amend the macro.
-
Re: Trigger needed
I'm assuming that the extract starts in A1, and that you want columns A:D plus the header row where column E shows as DUE when the workbook is open. I'm also assuming that this is the only sheet in the workbook, or at least will be the active sheet when the workbook is opened. The following macro should go in the ThisWorkbook section of the VBA editor.
Code
Display More[Code] Private Sub Workbook_Open() If Application.WorksheetFunction.COUNTIF(ActiveSheet.Range("E:E"), "DUE") > 0 Then mymsg = "≪HTML≫≪Body≫Text to appear before table" mymsg = mymsg & "≪Table≫≪TR≫" mymsg = mymsg & "≪TD≫" & ActiveSheet.Cells(1, 1).Value & "≪/TD≫" mymsg = mymsg & "≪TD≫" & ActiveSheet.Cells(1, 2).Value & "≪/TD≫" mymsg = mymsg & "≪TD≫" & Format(ActiveSheet.Cells(1, 3).Value, "dd/mm/yyyy") & "≪/TD≫" mymsg = mymsg & "≪TD≫" & Format(ActiveSheet.Cells(1, 4).Value, "dd/mm/yyyy") & "≪/TD≫" mymsg = mymsg & "≪/TR≫" For n = 2 to ActiveSheet.Range("A1").End(xlDown).Row If ActiveSheet.Range("E" & n).Value = "DUE" Then mymsg = mymsg & "≪TR≫" mymsg = mymsg & "≪TD≫" & ActiveSheet.Cells(n, 1).Value & "≪/TD≫" mymsg = mymsg & "≪TD≫" & ActiveSheet.Cells(n, 2).Value & "≪/TD≫" mymsg = mymsg & "≪TD≫" & Format(ActiveSheet.Cells(n, 3).Value, "dd/mm/yyyy") & "≪/TD≫" mymsg = mymsg & "≪TD≫" & Format(ActiveSheet.Cells(n, 4).Value, "dd/mm/yyyy") & "≪/TD≫" mymsg = mymsg & "≪/TR≫" End If Next mymsg = mymsg & "≪/TABLE≫≪/Body≫≪/HTML≫" Dim olApp As Outlook.Application Dim objMail As Outlook.MailItem Set olApp = Outlook.Application Set objMail = olApp.CreateItem(olMailItem) With objMail .BodyFormat = olFormatHTML .HTMLBody = mymsg .To = "[email protected]" 'Put recipient email address here .Send End With End If End Sub
Edit: Note that the code is displaying differently from how I entered it! Where it shows a double "less than" or "greater than" symbol, replace it with a single symbol.
-
Re: Macro copy master sheet to end of workbook, identical sheet with formula values
That may be why ... I'm still using 2007! Also I hadn't realised that you still wanted the formats, you would have needed an extra line for that.
Glad its working now though! -
Re: Trigger needed
It depends when the emails should be sent. The original post ended "...when the spreadsheet is opened", in which case you need the open event. But it may be more appropriate to send emails as changes happen. Either way, an example would help!
-
Re: Trigger needed
You need a On Workbook Open macro: https://msdn.microsoft.com/en-…rary/office/ff196215.aspx .
If you could provide a bit more information (e.g. what column contains the if formula, what details - cell references - you need brought into the email) I can do a sample macro. -
Re: Auto-copy a row range based on cell value to another sheet
What's the wording of the error message (it doesn't appear on your jpg)? Is it something like "Subscript out of range"?
If the error is on the highlighted line, its only a line to select a range. So I'm wondering whether the line above is returning a row number that's too high (i.e. Excel is including blank rows in the UsedRange)?
-
Re: Auto-copy a row range based on cell value to another sheet
Try this, it needs to be in the FullRecord sheet part of VBA, not a separate module:
Code
Display MorePrivate Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 6 Then Application.ScreenUpdating = False If Target.Value = "On Duty" Then Sheets("FullRecord").Range("B" & Target.Row & ":H" & Target.Row).Copy myRow = Sheets("OnDuty").UsedRange.Row + 1 Sheets("OnDuty").Range("B" & myRow & ":H" & myRow).Select Sheets("OnDuty").Paste Target.Select End If If Target.Value = "Leaver" Then Sheets("FullRecord").Range("B" & Target.Row & ":H" & Target.Row).Copy myRow = Sheets("Leavers").UsedRange.Row + 1 Sheets("Leavers").Range("B" & myRow & ":H" & myRow).Select Sheets("Leavers").Paste Target.Select End If Application.ScreenUpdating = True End If End Sub