Worksheet copy to include copy of Sheet Buttons - excel

I have a workbook where I have a worksheet that is copied by the user hitting a button (runs the code below). I want to make a copy of the worksheet as a new instance (this part is working) and also include the buttons on the copied sheet (this is where I am having trouble in later versions of excel).
The code works in older versions of excel but in 2010 and above the worksheet is copied but the buttons are not.
My current code is as follows;
Private Sub NewOrderSheet()
Application.ScreenUpdating = False
Dim pN As String
Dim pNB As String
Dim pNC As String
Dim pND As String
pN = Worksheets("ProjectDetails").Range("B5").Text
pND = ("Order Number: " & pN)
pNB = InputBox(pND)
If Len(pNB) = 0 Then
MsgBox "An order number must be given to be able to generate a new order.", vbCritical
Exit Sub
Else
End If
pNC = pN & "-" & pNB
Worksheets("QuoteSheet").Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).name = pNC
Application.ScreenUpdating = True
End Sub
Basically I create a new instance of the worksheet and then allow the user to give the worksheet a new name (in this case a new order).
The worksheet contains 2 buttons;
Button 1 - Copies the worksheet into a new workbook and removes all formulas
Button 2 - Formats the used range for printing
I have searched the questions and tried a number of variations but cannot seem to get the buttons to copy over.
I am very new to VB for excel so my apologies in advance if this is something simple.

I had the same problem. I checked all security concerning settings and tried everything. And then I found out that deleting the %Temp% Folder helps.
The true reason is, you have to search for a "MSForms.exd" File and delete it.
Then everything works fine again (:

Related

How can I add sheets from an excel file to another?

So I am trying to write a Macro for Excel, that adds 2 worksheets from an excel file to a new one.
Therefore, I try this:
Sub addfile()
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Set sheet1 = Sheets.Add(Type:="C:\Users\Helge\AppData\Roaming\Microsoft\Templates\page1.xltx")
Set sheet2 = Sheets.Add(Type:="C:\Users\Helge\AppData\Roaming\Microsoft\Templates\page2.xltx")
End Sub
When I test it, it imports the first page, but the 2nd page gives me a Runtime error 1004.
Why does this happen?
And is there another way to get 2 sheets from one excel file to another via vba?
Much to my surprise this version of your code actually worked for me.
Sub addfile()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = Sheets.Add(Type:=Environ("Userprofile") & "\OneDrive\Desktop\Template1.xltx")
Set Sheet2 = Sheets.Add(Type:=Environ("Userprofile") & "\OneDrive\Desktop\Book2.xlsx")
Debug.Print Sheet1.Name, Sheet2.Name
End Sub
The reason for my surprise is that Sheet1 and Sheet2 are the default CodeName for the first and second worksheets in any workbook. Therefore there is a conflict of naming between the Sheet1 in the workbook and the Sheet1 you declare which should come to the surface not later than Debug.Print Sheet1.Name. In fact, it may have. I didn't check which name was printed. But the code didn't crash. Since it crashes on your computer, perhaps you have an older version of Excel. Try to stay clear of variable names that Excel also uses. Or there is something wrong with the path & file name, which is hard to tell in that syntax and therefore kept me fooled for quite some time too.
In fact, I discovered the above only after finding out that my Desktop was on OneDrive and not before I had written the function below which is designed to avoid the use of Sheets.Add. It also has some extras such as being able to specify the sheet to take from the template (you could have one template with 2 or more sheets). You can specify an index number or a sheet name. And the function will give a name to the copy, too, if you specify one.
Private Function AddWorksheet(ByVal Template As String, _
TabId As Variant, _
Optional ByVal TabName As String) As Worksheet
Dim Wb As Workbook
Dim Path As String
Dim FileName As String
Set Wb = ThisWorkbook ' change to suit
' make sure the path ends on "\"
Path = "C:\Users\Helge\AppData\Roaming\Microsoft\Templates\"
With Workbooks.Open(Path & Template)
.Sheets(TabId).Copy After:=Wb.Sheets(Wb.Sheets.Count)
.Close
End With
Set AddWorksheet = ActiveSheet
If Len(TabName) Then ActiveSheet.Name = TabName
End Function
You can call the function from a sub routine like this:-
Sub AddWorksheets()
Dim Tab1 As Worksheet
Dim Tab2 As Worksheet
Application.ScreenUpdating = False
Set Tab1 = AddWorksheet("Page1.xltx", 1, "New Tab")
Set Tab2 = AddWorksheet("Page2.xltx", "Sheet1", "Another new Tab")
Application.ScreenUpdating = True
End Sub
Please observe the difference between the two function calls.

Workbook.close causes sub to exit

I have a set of versioned Excel documents that I am trying to get to auto-update when there is a new version available. What fails is that the .close method is not just closing one of the workbooks but also exiting the sub.
The process:
The sub gets called from Worksheet_Activate and immediately checks to see if an upgrade is needed. If needed, it collects all of the names of the sheets (except the "Count" sheet which is a copy from a template), creates a new workbook with the same sheets as the old one, copies the data over to the proper sheets, closes the old workbook, deletes the old workbook, saves the new workbook with the same name as the old workbook.
Pretty straight forward and it worked great until it didn't. I'm not sure why, but now when the wkbFrom.Close command is executed it also exits the procedure.
I've been digging around and the only answer I could find that seemed to address my issue was to give some delay before/after the close so that Excel will have time to finish and not collide with itself. So I tried putting in a 5 second delay before the close command but to no avail.
Excel doesn't crash, it's still up and running properly. I checked the Event Viewer and Excel is not throwing any errors. The sub simply closes the workbook and then exits the sub.
Here is the full code for the sub.
Sub UpgradeHWWorkbook(Optional HWSheetVersion As Double)
'--------------------------------
'This sub upgrades a hardware tracking
'workbook to the newest version based on
'version in the variable HWSheetVersion
'--------------------------------
'Before anything else, Check to see if upgrade is needed.
'If sheet version is equal or larger than the plugin version
'OR the name of the sheet is wrong, exit without upgrading
'---------------------------------------------------------------------
If HWSheetVersion >= HWPlugInVersion Or _
Not ActiveSheet.CodeName Like "BaseHWSheet_*" Then
Exit Sub
End If
'---------------------------------------------------------------------
'VAR declarations----------------
Dim wkbFrom As Workbook 'Holds the original workbook
Dim wkbTo As Workbook 'Holds the new workbook
Dim sWKB As Workbook 'Holds Workbook where Count sheet is kept
Dim sWKS As Worksheet 'Holds Count sheet
Dim wks As Worksheet 'Holds worksheets
Dim wksNames() As String 'Holds the names of all the worksheets
Dim wkbFromName As String 'Holds the name of the original workbook
Dim wkbFromPath As String 'Holds the path of the original workbook
Dim wkbToPath As String 'Holds the path where the new workbook will be saved
Dim rng As String 'Holds the range of cells that will be copied
Dim x As Byte 'Holds counter
Dim wksName As Variant 'Holds the name of the current worksheet
'--------------------------------
'Sub Settings--------------------
Set wkbFrom = ActiveWorkbook 'Set the active workbook as the one that the data comes from
wkbFromPath = wkbFrom.Path 'Grabs the path of the original workbook
wkbFromName = wkbFrom.Name 'Grab the original workbook name
wkbToPath = wkbFrom.FullName 'Grab the path path and name in another var so we don't have to do it by hand
ReDim wksNames(0) 'Starts off the array that will hold the worksheet names
x = 0 'Flush the counter
rng = "A2:D18" 'The range of cells that will be copied and pasted
Application.DisplayAlerts = False 'Turn off annoying pop-ups
Set sWKB = Workbooks("StockroomAddins.xlam") 'Workbook with Count sheet to copy to new workbook
Set sWKS = sWKB.Worksheets("Count") 'Count sheet to copy to new workbook
'--------------------------------
'Get all of the worksheet names (except Count) in the workbook
'-----------------------------------------------------------------------
For Each wks In wkbFrom.Worksheets 'itenerate through the book
If Not wks.Name = "Count" Then 'If the worksheet isn't the "Count" sheet...
wksNames(x) = wks.Name 'add the sheet name to the array wksName()
x = 1 + UBound(wksNames) 'Increase the array by 1
ReDim Preserve wksNames(x) 'Increase the size of the array by 1
End If
Next wks
'-----------------------------------------------------------------------
'Create new workbook & add Count sheet
'-----------------------------------------------------------------------
Set wkbTo = Workbooks.Add 'Create the new workbook
wkbTo.Activate 'Make sure new book is active book
sWKS.Copy Before:=Sheets("Sheet1") 'Add the Count sheet to workbook
'-----------------------------------------------------------------------
'Iterate through the sheets in the original workbook, add sheets with the same name to the new book, copy data from the old sheet to the new sheet
'-----------------------------------------------------------------------
For Each wksName In wksNames 'Loop through all of the worksheet names and...
If Not wksName = "" Then 'If it isn't blank...
Call NewHardwareTrackingSheet(wksName, wkbTo) 'Call the sub that creates a new tracking sheet
wkbFrom.Worksheets(wksName).Range(rng).Copy 'Copy the data from the old sheet
wkbTo.Worksheets(wksName).Range(rng).PasteSpecial _
Paste:=xlPasteValues 'Paste the data (Values only) into the new sheet
End If
Next wksName
wkbTo.Worksheets("Sheet1").Delete 'Delete the default "Sheet 1" that every new workbook has
wkbFrom.Close Savechanges:=False 'close the original workbook
'-----------------------------------------------------------------------
'Delete the old workbook and save the new one in the same place with the same name as the old one
'-----------------------------------------------------------------------
Kill wkbToPath 'Kill the original
wkbTo.SaveAs Filename:=wkbToPath, FileFormat:=52 'Save the new as the original
Application.DisplayAlerts = True 'Turn annoying pop-ups back on
'-----------------------------------------------------------------------
'Clean up-------------------------------------
Set wkbFrom = Nothing: Set wkbTo = Nothing: Set sWKB = Nothing
Set wks = Nothing: Set sWKS = Nothing
'---------------------------------------------
End Sub
Any ideas on what I've messed up? I figured that since it worked at one point and now doesn't, that I've probably messed up the code somewhere but I'm not seeing it.
OK, I found my answer and I feel a bit stupid about it. Thanks to the folks who asked me some questions because they caused the thought process that worked.
It seems that the spreadsheet I was using to test the code must have gotten corrupted. I tried it on a couple of other files and it worked correctly. No wonder I couldn't find a code issue: there isn't one.
Goes to show the old adage "Measure twice, cut once." I should have tested on multiple files and not assumed my single test file was right.
Much thanks to those who read, thought about, and commented on my post. It is appreciated.
EDIT: Or not......
Came in this morning and it's not working again. There's got to be something in my code that is causing the issue on some and not on others. TBH, I have no idea what it is.
This is really causing me to bang my head on the wall.
OK, so I think I've figured this out.
I am calling this Sub to check the version each time a sheet is activated with this:
Public Sub Worksheet_Activate()
Application.Run "StockroomBarcodeSheets.UpgradeHWWorkbook", HWSheetVersion
End Sub
To do some other testing, I set up another sub inside my plug-in that just called the UpgradeHWWorkbook sub with a fake HWSheetVersion so I could force a workbook to upgrade. Lo, and behold, this setup worked perfectly every time.
So, when I call from the Worksheet_Activate() it exits on the .close command. When I call it from a sub inside the add-in, it works perfectly.
Because the UpgradeHWWorkbook is in a plug-in I thought that the restriction upon closing the calling workbook wouldn't come into affect. I was wrong.

How to use result of input box as a worksheet name in VBA code

I'm really new at VBA and have learned what I know so far from internet searches, but I cannot find a resolution to my issue.
I have two workbooks, one with information on all of my company's current projects and another with just the active projects. The Active Projects workbook is where we store all the documents that need reviewing for each project. Each project has it's own worksheet.
When I create a new worksheet in the Active Projects workbook, I would like to use a macro to fill in the relevant project information from the All Projects Workbook.
I have seen code that copies cells and ranges from one workbook to another, but they have the sheet names hard coded in. Like this:
'Copy range to in selected row to clipboard
Workbooks("All Project.xlsx").Worksheets("All Open").Range("B" & (ActiveCell.Row)).Copy
'PasteSpecial to paste values, formulas, formats, etc.
Workbooks("Active Projects.xlsm").Worksheets(InputBoxValue).Range("A2").PasteSpecial Paste:=xlPasteValues
I thought to use an input box to ask for the worksheet name where the copied data would be pasted, but after hours of research, I cannot find out to use the result of the input box for the worksheet name.
Thank you for furthering my VBA education
FYI - this is at high risk of someone putting in the wrong sheet name given the nature of free-form text. That is something you will need to handle on your end so I suggest you look up:
How to check if a sheet given name exists on a book
How to loop a InputBox until an acceptable input is given
Dim Sheet_Name As String
'Get Input
Sheet_Name = Application.InputBox("Enter Sheet Name", Type:=2)
'Use Input
MsgBox ThisWorkbook.Sheets(Sheet_Name).Name
Dim InputBoxValue As String
InputBoxValue = InputBox("Enter sheet name")
'PasteSpecial to paste values, formulas, formats, etc.
Workbooks("Active Projects.xlsm").Worksheets(InputBoxValue).Range("A2").PasteSpecial Paste:=xlPasteValues
Below code will rename active sheet :
Sub Rename_Worksheet()
Dim Str As String
Dim Ws As Worksheet
Set Ws = ActiveSheet
Str = InputBox("Please provide new name for Worksheet : " & Ws.Name)
Ws.Name = Str
MsgBox "Worksheet renamed successfully to " & Str
End Sub

How to get dependent drop-down lists to work in exported workbook?

I'm still reasonably new to VBA and feel I'm punching a little above my weight, so hopefully someone can help.
I need to issue a spreadsheet to people in my company which they can fill out and send it back. This needs to be done multiple times, so I have tried to automate this as much as possible. The source data is pasted in an "input" tab - this is then pivoted by user and input into a template tab. I can select any user and run a macro which does this and exports the filled out template to a new workbook.
In this template tab, I have dependent drop-down lists, which I have done by data validation - this relies on named ranges from the "coding" tab, which is also exported. One named range shows a list of values, and the other indexes over this and matches it to the required cell, to ensure only valid combinations are shown.
My issue is that the new workbook must not contain any links to the master - it should function completely in its own right. However, something is going wrong with the data validation/named ranges. Either some named ranges are being deleted (I know which bit of code is doing that but without it you get prompted to update links) or the data validation formula links back to the original workbook and doesn't work. I cannot find another way of achieving what I need without this particular data validation set up, so I need to try and adjust my macro to cater for this.
Is it possible to simply copy the template and coding tabs, with all the data validation, to a new workbook and break all links to the original, so that there are no startup prompts and the drop-downs all work?
Sub Copy_To_New_Workbook()
Dim wb As Workbook
Dim name As String
Dim ExternalLinks As Variant
Dim x As Long
Dim strFolder As String, strTempfile As String
name = Worksheets("Control").Cells(14, 7).Value
Let FileNameIs = Range("Filepath").Value & Range("FileName").Value
Set wb = Workbooks.Add
ThisWorkbook.Worksheets("Coding").Copy Before:=wb.Sheets(1)
ActiveSheet.name = "Coding"
ThisWorkbook.Worksheets("Transactions").Copy Before:=Worksheets("Coding")
ActiveSheet.name = "Transactions"
With ActiveSheet.UsedRange
.Value = .Value
End With
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
For x = 1 To UBound(ExternalLinks)
wb.BreakLink name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
Next x
Dim objDefinedName As Object
For Each objDefinedName In wb.Names
If InStr(objDefinedName.RefersTo, "[") > 0 Then
objDefinedName.Delete
End If
Next objDefinedName
On Error GoTo 0
wb.SaveAs Filename:=FileNameIs, FileFormat:=52
ActiveWorkbook.Close
End Sub

Problems activating worksheet in excel 2013

My macro's were working perfect in excel 2010, but in 2013 I have a major problem with activating workbook in vba and than when certain sheet is selected + cell is selected I can fill in data, but when pressing enter or arrow key, the data is set to the first visible page of my file.
This happens when I activate another workbook, but also in the same workbook when I select a certain sheet, the data entered will go to the first sheet... what has changed from excel 2010 to 2013 that makes this happen??
this is the code I use:
Workbooks(MachineInspectieLijst & ".xlsm").Activate
Workbooks(MachineInspectieLijst & ".xlsm").Worksheets(MachineInspectieLijst).Range("V5").Select
When I fill in a value in V5 and enter, the value disappears and shows up on V5 in first page...mostly.
When I manually switch between the pages or workbooks, than it works... I founnd nowhere an answer.
hope somebody has the answer.
Do the process sequentially:
Sub hfjsdfh()
Workbooks(MachineInspectieLijst & ".xlsm").Activate
Worksheets(MachineInspectieLijst).Select
Range("V5").Select
End Sub
This is the actual sub, I tried your suggestion, but exactly the same...Indeed, it is like the second workbook is not really activated, but how to solve? has it to do with the userform who stays loaded? this one must stay loaded, as it contains lot of necessary information and is only unloaded at new start. Nevertheless, I tried to unload as test, but same problem. Can it be due to excel itself?
Private Sub CmdGetInspectionList_Click()
Dim thesentence As String
Dim WB As Workbook
Set WB = ThisWorkbook
Dim WB2 As Workbook
frmKlantSelectie.Hide
Application.EnableEvents = False
If Me.cboDocumentType.Value = "Sales Budget Quotation" Then
MachineInspectieLijst = "Machines_Sales"
WB.Worksheets("PreInspArticles").Range("J1") = "Sales"
Else
MachineInspectieLijst = Me.cboInspectieMachine.Value
End If
loginnaam = StrConv(WindowsUserName, vbUpperCase)
thesentence = "C:\Users\" & loginnaam & "\Dropbox\2_Doc_Service\DATA\Pre_Inspection_Checklist\" & MachineInspectieLijst & ".xlsm"
'checken ofdat de file wel bestaat in de directory
If Dir(thesentence) <> "" Then
MsgBox "Machine Check list exists! Press 'OK' and file will be shown!"
'Test to see if the file is open.
If IsFileOpen(thesentence) Then
Workbooks(MachineInspectieLijst & ".xlsm").Activate
Else
'Display a message stating the file is not in use.
Set WB2 = Workbooks.Open(thesentence)
End If
Else
MsgBox "No machine selected Or Check list not yet existing."
frmKlantSelectie.Show
Me.TxtInspectionList.SetFocus
Exit Sub
End If
WB2.Worksheets(1).Range("V5").Select
Application.EnableEvents = True
End Sub

Resources