Hello, I would like to create two VBA macros for Excel that accomplish the following:
(1) open "Master" workbook, prompt to open a "Rep" workbook, then copy & paste 4 sheets from Rep wb and replace the corresponding sheets in Master wb.
(2) Add a function that renders the workbook useless after a certain time frame.
Any suggestions?
Greetings,
Okay - maybe it's just me, but your request seems a wee bit unclear.
'open "Master" workbook...' - is "Master.xls" the name of the wb? Is it in the same folder as the wb we're writing the code in?
'...prompt to open a "Rep" workbook,...' - What are we prompting the user for: whether to proceed, or are we giving the user some type of choice as to what wb will be opened/extracted from?
'...then copy & paste 4 sheets...' - Give us a hint here, do the sheets have names?
'...Add a function that renders the workbook useless...' - Far as I can tell, we have three workbooks. Which one is this referring to?
Now more importantly, I see you just joined :-) In my opinion, you have joined the best forum around. You will meet some great folks here, who will go out of their way to be helpful. I certainly hope you don't get discouraged at my questions, as my intent is to be helpful, and I think with some additional details/clarity in the request, you'll get a great solution.
Hope this helps,
Mark
Thanks Mark. Please see below.
'open "Master" workbook...' - is "Master.xls" the name of the wb? Is it in the same folder as the wb we're writing the code in? **Master.xlsm is the name of the workbook. It typically does not reside in the same folder as Rep.xls (master is the wb that receives the info form rep)
'...prompt to open a "Rep" workbook,...' - What are we prompting the user for: whether to proceed, or are we giving the user some type of choice as to what wb will be opened/extracted from? **allows the user to select a workbook; the example here is named rep.xls.
'...then copy & paste 4 sheets...' - Give us a hint here, do the sheets have names? ** sheet names are "Summary", "Proposal", "Analysis" and "Investor Summary" - these worksheets are named identically in all rep worksheets and master.
'...Add a function that renders the workbook useless...' - Far as I can tell, we have three workbooks. Which one is this referring to? ** there are two workbooks (rep.xls <this name will always be different> and master.xlsm. The wb that needs to expire is rep.xls.
Thanks!
jpirhalla,
Try:(2) Add a function that renders the workbook useless after a certain time frame.
Deleteing a file in VBA, by Tom Urtis
http://www.mrexcel.com/forum/showthread.php?t=48867
By Justinlabenne
http://www.vbaexpress.com/forum/showthread.php?t=3923
Excel Frequently Asked Questions, Ozgrid.com
Sub DeleteThisModule() Dim vbCom As Object MsgBox "Hi, I will delete myself " Set vbCom = Application.VBE.ActiveVBProject.VBComponents vbCom.Remove VBComponent:= _ vbCom.Item("Module1")End Sub
You can also, after a certain date, do a file save as "Read Only" - but I can not find it in my archives.
Have a great day,
Stan
Greetings,
Please note that I wrote the file filtering for xl2003 and before. I think that FileFilter:="Microsoft Office Excel Workbook(*.xls; *.xlsm), *.xls; *.xlsm" would also display 2007 files, but cannot test, so didn't include.
I would note that you may wish to save a copy of master.xlsm as master.xls (ie - earlier format) until you're sure you have no more questions, as there's still plenty of us who don't have 2007, and thus cannot open any attachment...
Anyways, in a Standard Module:
[vba]Option Explicit
Public Sub Sheets_Import()
Dim _
wbSource As Workbook, _
wksSource As Worksheet, _
wksDest As Worksheet, _
bytSheet As Byte, _
intIndex As Integer, _
strSourceWB As String, _
aSheets() As Variant
'// Assign the return string from PickFile() //
strSourceWB = PickFile
If Not strSourceWB = "False" _
And Not strSourceWB = ThisWorkbook.FullName Then
'// User picked a 'good' wb, so kill screen updating and calculating for the //
'// moment. //
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'// Set a reference to the wb the user chose...//
Set wbSource = Workbooks.Open(Filename:=strSourceWB, _
ReadOnly:=True, _
AddToMru:=False)
Else
'// ...or exit if they cancelled or chose this workbook. //
Exit Sub
End If
'// Assign array of sheets we want to copy. If you add a sheet later, you need to //
'// change: For bytSheet = 0 To 4. //
ReDim aSheets(0 To 3)
aSheets() = Array("Summary", "Proposal", "Analysis", "Investor Summary")
'// Loop for as many sheets as we're "importing". //
For bytSheet = 0 To 3
'// Clear any errors. //
Err.Clear
'// Temporarily handle errors in-line. //
On Error Resume Next
'// Set a reference to the next worksheet to be imported...//
Set wksSource = wbSource.Worksheets(aSheets(bytSheet))
'// ...If there is no error, then the source wb contains the sheet... //
If Not Err.Number > 0 Then
'//...So then see if we have a sheet to overwrite... //
Set wksDest = ThisWorkbook.Worksheets(aSheets(bytSheet))
'// If no error now, we have a sheet to "overwrite", so... //
If Not Err.Number > 0 Then
'// ...get its Index and delete the old sheet... //
intIndex = wksDest.Index
Application.DisplayAlerts = False
wksDest.Delete
Application.DisplayAlerts = True
Else
'//...elswise, assign 1. //
intIndex = 1
End If
'// Now copy source wb sheet to destination wb, placing it in the same //
'// order as the old sheet, or, if no old sheet, at front (leftmost tab) of //
'// sheets. //
wksSource.Copy Before:=ThisWorkbook.Sheets(intIndex)
'// Else - Nothing. If the first IF found an error, then there's a missing //
'// sheet in source wb, so skip to next loop. //
End If
Next
'// Clear any remaining error. //
Err.Clear
'// Close source wb. //
wbSource.Close SaveChanges:=False
'// Turn stuff back on. //
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Function PickFile() As String
Const Dialog_Title As String = "Pick a file to import sheets from"
If Not Left(CurDir(), 1) = Left(ThisWorkbook.Path, 1) Then
ChDrive Left(ThisWorkbook.Path, 1)
End If
ChDir ThisWorkbook.Path & Application.PathSeparator
PickFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Office Excel Workbook(*.xls), *.xls", _
Title:=Dialog_Title, _
MultiSelect:=False)
End Function[/vba]
Hope this helps,
Mark
Mark,
Thanks for the assistance. My concern is pertaining to the following:
If Not Err.Number > 0 Then
'// ...get its Index and delete the old sheet... //
intIndex = wksDest.Index
Application.DisplayAlerts = False
wksDest.Delete
Application.DisplayAlerts = True
Else
If the old sheet in Master.xls is deleted before the new sheet from Rep is pasted, then won't the references from other sheets in Master.xls that reference the sheets to be replaced return a #REF! is the sheet is deleted and then replaced? If so, then is there a way to replace the contents of each sheet without deleting it? That way the existing references throughout Master.xls will remain intact?
With regards to expiring the workbook on a certain date - I do not want to delete the workbook. I would like include the following functionality:
1. on a certain date, prompt the user for a password.
2. if the password is incorrect, hide all sheets except a blank sheet and save without without asking. So the next time the user opens the workbook he only sees the blank sheet and cannot unhide the other sheets. If the password is correct, End Sub.
3. I can then protect the VBA code so the user needs a password to access the code to unhide the hidden sheets.
Greetings j,
Reference your last at #6, yes, if there are dependent cells, the formulas will be goobered up.
I am afraid the replacing the corresponding sheets part threw me a bit.Originally Posted by jpirhalla
If I didn't mention it already, of course try this first in a copy of your wb, in case anything else is overlooked. Let's try this, to copy all the cells from ea source sheet.
[vba]Option Explicit
Public Sub Sheets_CopyAll()
Dim _
wbSource As Workbook, _
wksSource As Worksheet, _
wksDest As Worksheet, _
bytSheet As Byte, _
strSourceWB As String, _
aSheets() As Variant
'// Assign the return string from PickFile() //
strSourceWB = PickFile
If Not strSourceWB = "False" _
And Not strSourceWB = ThisWorkbook.FullName Then
'// User picked a 'good' wb, so kill screen updating and calculating for the //
'// moment. //
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'// Set a reference to the wb the user chose...//
Set wbSource = Workbooks.Open(Filename:=strSourceWB, _
ReadOnly:=True, _
AddToMru:=False)
Else
'// ...or exit if they cancelled or chose this workbook. //
Exit Sub
End If
'// Assign array of sheets we want to copy. If you add a sheet later, you need tp //
'// change For bytSheet = 0 to 4. //
ReDim aSheets(0 To 3)
aSheets() = Array("Summary", "Proposal", "Analysis", "Investor Summary")
'// Loop for as many sheets as we're "importing". //
For bytSheet = 0 To 3
'// Clear any errors. //
Err.Clear
'// Temporarily handle errors in-line. //
On Error Resume Next
'// Set a reference to the next worksheet to be imported...//
Set wksSource = wbSource.Worksheets(aSheets(bytSheet))
'// ...If there is no error, then the source wb contains the sheet... //
If Not Err.Number > 0 Then
'//...So then see if we have a sheet to overwrite... //
Set wksDest = ThisWorkbook.Worksheets(aSheets(bytSheet))
'// If no error now, we have a sheet to "overwrite", so... //
If Not Err.Number > 0 Then
'//***COPY all the cells on the Source sheet to the Destination sheet. //
wksSource.Cells.Copy Destination:=wksDest.Cells
Else
'// If no sheet ("Summary" for instance) in the Destination wb //
'// (ThisWorkbook), import a copy of the sheet. //
wksSource.Copy Before:=ThisWorkbook.Sheets(1)
End If
End If
Next
'// Clear any remaining error. //
Err.Clear
'// Close source wb. //
wbSource.Close SaveChanges:=False
'// Turn stuff back on. //
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub[/vba]
As to the disabling the source wb's after a certain amount of time, while I understand that the KB currently has issues, if you read carefully thru what Stan offered, you would see that brettdj's article references johnske's article on setting a trial period.
Workbook Suicide brettdj http://www.vbaexpress.com/kb/getarticle.php?kb_id=540
Set a Trial Period johnske http://www.vbaexpress.com/kb/getarticle.php?kb_id=475
As to effectively using this, several issues had already made me decide not to tackle this, namely: If the users are compliant, there's no need. If they are not compliant, the "expiring" wb's will need to effectively force enabling of macros.
Then non-compliant users will just copy the sheets to a new uncoded wb.
To battle that, you get to write a decent amount of code hiding/disabling commandbars (toolbars). Then you'll find out how many shortcut key combos there are that you never knew about...
In short, only my opinion, but a lot of work vs. just having whoever is using the master not select wb's over so old... If it still sounds like a ton o' fun though, here's a wb attached showing what seems to be a reliable manner of forcing enabling of macros.
Mark
GTO,
Your code looks great. But for some reason it causes Excel to hang (have to go into Task Mgr to End). Thoughts?
Can your code be modified to something similar to function below for each sheet so that I can step into it to find where it's hanging?
Windows("Rep.xls").Activate
Sheets("Submission Form").Select
Cells.Select
Range("B1").Activate
Selection.Copy
Windows("Master.xlsm").Activate
Sheets("Submission Form").Select
Cells.Select
ActiveSheet.Paste
Mark,
Regarding the ForceEnable issue, how may I ensure that only sheets "Submission", "Rent" and "Analysis" are visible if macros are enabled and the remaining sheets in hte workbook remain hidden?
For Each wksWorksheet In ThisWorkbook.Worksheets
If Not wksWorksheet.CodeName = "shtForceEnable" Then
wksWorksheet.Visible = xlSheetVeryHidden
End If
Next
j,
I am unable to replicate any hangs, and cannot see what would cause it. Of course we cannot see any mods or parameters of your workbook(s) that I haven't thought of (and believe me, there's plenty I forget).
So... after taking out any private/sensitive data, post a copy of what you have so far. That is, a copy of master.xls, as well as an example of a Rep wb. When posting attachments, there is a one attachment per post limitation; but you can put both wb's in a zip file and get it attached to one post that way.
After you zip the workbooks, press the Go Advanced button, and you will see Additional Options below the window you type in. In Additional Options, press the Manage Attachments button, it is self-explanatory therafter.
Reminder: remember to saveas the workbook examples in pre-2007 format.
Mark
Mark,
Sorry for not being more thorough... it appears there may be an issue if the sheets in Rep are protected. Once I unprotected all sheets, it worked fine. Awesome! Many thanks!
Hi j,
Happy to help and glad it worked out. If solved, you can mark it as such by clicking on Thread Tools right above your first post. This saves members time in not checking stuff that's already resolved.
Thanks,
Mark
Mark
Solved. Any additional thoughts on the ForceEnable issue? How may I ensure that only sheets "Submission", "Rent" and "Analysis" are visible if macros are enabled and the remaining sheets in hte workbook remain hidden?
Posting Permissions
Reply With Quote
