Following up from my previous post (of same title). I have a user form from which I need to look up data based on a list of items in a drop down box "XXXXList". The VBA code works partially. The code is able to look for and open the right file from the intranet called "database". But once the file is opened, I get the following error message "Automation error".
The code i have is:
Private Sub ContractsList_AfterUpdate()
Dim WB As Workbook
Dim Sht As Worksheet
' set workbook to workbook location at internet
Set WB = Workbooks.Open("https://Private.Private.Private.uk/Private/Private/Private/Private/Private.xlsm")
Set Sht = WB.Worksheets("Availabledata")
Application.Wait (Now + TimeValue("00:00:01"))
Workbooks("database.xlsm").Close
With Me.XXXXList
'value to be found in Column H of 3rd worhseet
If Not IsError(Application.Match(.Value, Sht.Range("H:H"), 0)) Then
'Lookup values based on first control
Me.TextBox1 = Sht.Range("H" & Application.Match(.Value, Sheet3.Range("H9:H100"), 2)).Value '<-- value not found in Column H
Else
MsgBox "This contract is not on the list"
.Value = ""
Exit Sub
End If
End With
End Sub
Also, the worksheet "database.xlsm" is meant to flash open for a second and then close immediately, but instead it asks me if I want to save the data.
I don't want really want that, is it possible to skip that step and close it automatically?
Related
Good morning. so in essence i have built a whole bunch of macros that work fine after a lot of work. trouble i have is the macros will always need to perform actions on other workbooks ie: "macro workbook" contains macros that perform actions on "January 2018 data". The reason for this is that the monthly data sheets are always new so i cant store macros on them.
i personally and happy to open a separate workbook, press f11 and run the correct macro. there may be end users in the future however that are not comfortable with this and so i want to employ the use of a button. obviously by implementing a button on the "macro workbook", it applies the macros function to the macro workbook, not the intended one.
In an ideal world i want to press the macro button and be presented with a list of currently opened workbooks that the user can read through and select the correct workbook. it will then select this open workbook and then continue with the macro.
Is this even possible? I'm new to VBA but i have never come across this before. the closest fix i can think of is to ask the user to input the file directory and name in a dialogue box, then use that to select the workbook to continue running the macro, such as:
Sub macro1()
Dim Filepath As String
Filepath = InputBox("Please enter the filename of workbook you wish to run the macro on", "Enter Filepath")
Workbooks(Filepath).Activate
rest of macro can then continue...
End Sub
I would just rather the user be able to click the name of the workbook rather than have to input it, to reduce the chance of them inputting it wrong.
There are so many ways that this could be implemented. Here is a very simple way which might give you at least one idea. In your main workbook with "your macros" … create UserForm with a Combobox and a Button on it … like the following:
Add the following code in the UserForm:
Option Explicit
Private Sub UserForm_Activate()
Dim vWorkbook As Workbook
ComboBox1.Clear
For Each vWorkbook In Workbooks
ComboBox1.AddItem vWorkbook.Name
Next
End Sub
Private Sub CommandButton1_Click()
If ComboBox1.ListIndex <> -1 Then
Call YourMacro(ComboBox1)
End If
End Sub
Private Sub YourMacro(vWorkbookName As String)
MsgBox Workbooks(vWorkbookName).Name
End Sub
Then create a module so that when you bring up the macro dialog box there a macro to load the form.
Option Explicit
Public Sub LoadForm()
UserForm1.Show
End Sub
When the form is activated, the code loads the names of the currently open workbooks into the ComboBox. You can select one. Click the button … and after it checks that a workbook has been selected, it runs an example macro which is mimicking your own macro (which in this example displays the workbook name by referencing the Workbooks object). Because clearly in "your" macros … they should be reference the selected Workbook.
Once again … clearly this is very rudimentary. Its intended to one example of what's possible and might point you in the right direction.
Another method, this will DO_THIS_MACRO on the also open workbook, if there is only 1 other workbook open. If there are 2 or more, will cycle through them asking if you want to DO_THIS_MACRO on that workbook, or go to next, or Cancel.
Sub DoOnOpenWorkbooks()
'Define a Workbook Object
Dim oWb As Workbook, iSh As Worksheet, WkbCount As Double, numa As Integer
'Traverse through each workbook Opened - Using Excel Application Object
WkbCount = 0
For Each oWb In Application.Workbooks
WkbCount = WkbCount + 1
Next oWb
' Do not list PERSONAL and this workbook
WkbCount = WkbCount - 2
Debug.Print "WkbCount: " & WkbCount
'Must be at least 1 other open workbook to continue
If WkbCount = 0 Then Exit Sub
For Each oWb In Application.Workbooks
'Ignore PERSONAL and this workbook
If oWb.Name <> "PERSONAL.XLSB" And oWb.Name <> ActiveWorkbook.Name Then
'If only 1 other workbook, do macro on that
If WkbCount = 1 Then
Workbooks(oWb.Name).Activate
DO_THIS_MACRO
Exit Sub
End If
Workbooks(oWb.Name).Activate
numa = MsgBox("There are " & WkbCount & " workbooks open. Do this on " & oWb.Name & "?", 3, "DO_THIS_MACRO")
If numa = 6 Then
' MsgBox "Yes option pressed!"
Workbooks(oWb.Name).Activate
DO_THIS_MACRO
' Exit or ask to do on all open
Exit Sub
ElseIf numa = 7 Then
'MsgBox "No option pressed!"
Else
' MsgBox "Cancel pressed!"
Exit Sub
End If
End If
Next oWb
End Sub
I am creating a spreadsheet that creates a reference number on the first worksheet (called database, to be used similarly to a database) and generates a new worksheet. This then gives a reference number on the new worksheet so that they are linked together. This is done by pressing "New Idea" on a UserForm.
Once this is completed it should then go to the newly created worksheet and highlight cell C7. Once this is complete it should close the UserForm and allow the user to be able to type in cell C7 on the new worksheet with no further steps needed.
This works fine if I use F8 to step through the process however if I close the code window and run through the process as a user would it doesn't work as it should.
C7 is highlighted but once you have typed in it and press enter to go to the cell below, what you've typed disappears completely, and whatever you type on the newly generated worksheet is actually entered on another worksheet.
I have a seperate worksheet that contains a button to open the UserForm and all data that is entered on the newly generated worksheet goes to this sheet incorrectly.
My code is below, and is all within the UserForm's code. I have left the ComboBox code below but this isn't relevant to the generation of the new worksheets. All that does is list the created tabs so the user can select a worksheet from the UserForm and go directly there rather than having to scroll sideways.
I'm using Excel 2013. I'm by no means a VBA veteran so any help would be greatly appreciated!
Thanks!
Private Sub UserForm_Initialize()
Me.ComboBox1.List = Worksheets("Database").Range("A2:A10000").Value
End Sub
Private Sub CreateNewIdea_Click()
CopySheet
End Sub
Sub CopySheet()
Dim LastRow As Long
NewReference
LastRow = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row - 1
ReturnValue = LastRow
Sheets("Idea Template").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = LastRow
Range("C3").Value = LastRow
Me.ComboBox1.List = Worksheets("Database").Range("A2:A10000").Value
Range("C7").Select
Unload Home
End Sub
Sub NewReference()
Dim LastRow As Long
LastRow = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Database").Cells(LastRow + 1, "A").Value = Sheets("Database").Cells(LastRow, "A").Value + 1
End Sub
Private Sub ComboBox1_Change()
Worksheets(ComboBox1.Text).Select
End Sub
I've taken the liberty to edit and rewrite the code you've written for greater flexibility.
Option Explicit 'Forces the variable to be declared, undeclared variables are not allowed
Dim DatabaseTable As ListObject 'Makes the variable usable for the entire module
Dim Lastrow As Long
Private Sub UserForm_Initialize()
Set DatabaseTable = ThisWorkbook.Worksheets("Database").ListObjects("References")
'I'm assuming you've formatted the data on the worksheet as a table and named the table "References"
Dim i As Long
Dim DatabaseRows As Long
DatabaseRows = DatabaseTable.ListRows.Count
With Me.ComboBox1
.Value = Empty
.Clear
For i = 1 To DatabaseRows
.AddItem DatabaseTable.DataBodyRange(i, 1)
Next i
End With
End Sub
Private Sub CreateNewIdea_Click()
Set DatabaseTable = ThisWorkbook.Worksheets("Database").ListObjects("References")
Call CopySheet
End Sub
Sub CopySheet() 'Are you calling Sub CopySheet() from other subs besides Private Sub CreateNewIdea_Click()?
Call NewReference
Dim ReturnValue As Long 'I'm declaring this variable because I'm using the option explicit and that doesn't allow undeclared variables
ReturnValue = Lastrow 'Unless ReturnValue is a public variable, it's not doing much here.
ThisWorkbook.Worksheets("Idea Template").Copy After:=ThisWorkbook.Worksheets(Worksheets.Count)
ThisWorkbook.Worksheets("Idea Template (2)").name = Lastrow
ThisWorkbook.Worksheets(CStr(Lastrow)).Cells(1, 3).Value = Lastrow 'Cstr(lastrow) is needed because we want the sheet with the name of the last row, not the nth sheet which is what happens with WorkSheets(Lastrow) as lastrow is a number
Call UserForm_Initialize 'Calls the procedure which fills ComboBox1, if the unload home refers to this form, then this line is redundant since the combobox is filled again when the form is initialized.
ThisWorkbook.Worksheets(CStr(Lastrow)).Cells(7, 3).Select
Unload Home 'If the name of this form is home, you can just 'Unload Me'
End Sub
Sub NewReference() 'Are you calling Sub NewReference from other subs besides Sub CopySheet()?
DatabaseTable.ListRows.Add AlwaysInsert:=False 'Adds a new row to the table on the worksheet "Database"
Lastrow = DatabaseTable.ListRows.Count
If Lastrow = 2 And IsEmpty(DatabaseTable.DataBodyRange(1, 1)) Then 'This if determines if a row was added while the first row does not contain a reference
DatabaseTable.DataBodyRange(Lastrow, 1).Value = 1 'First reference, can be anything you want really
DatabaseTable.ListRows(1).Delete 'First row is deleted, otherwise you'd have an empty first row
Lastrow = Lastrow - 1
Else
DatabaseTable.DataBodyRange(Lastrow, 1).Value = DatabaseTable.DataBodyRange(Lastrow - 1, 1) + 1
End If
End Sub
Private Sub ComboBox1_Change()
If Not Me.ComboBox1 = Empty Then
Worksheets(CStr(Me.ComboBox1)).Select
End If
End Sub
Revised answer
After looking at the document provided by #tomjo and trying to reporduce the problem I found that the problem was caused by the buttons on the sheets. The buttons used were the Form Controls rather than ActiveX Controls.
A macro was assigned to the Form Control The macro was defined in a module as you'd expect. The Macro only called to show the relevant form. It appeared as if the selected sheet, either by the menu on the form or after creating a new sheet from the form wasn't properly activated and the information entered in the sheet that showing was actually entered in the form which was last manually selected. Stepping through the code I found that the proper sheet and cell was active after the selection through the form through Debug.Print ThisWorkbook.ActiveSheet.Name, ThisWorkbook.ActiveSheet.ActiveCell.Address. I failed to discover why, while the correct sheet and cell were active, the information was entered in the last manually selected worksheet and cell.
To verify that the issue was not caused by the file somehow I tried to reproduce the problem with an entirely new file. Again the problem occurred that while the screen was showing the correct sheet and cell as selected (selected through a form, called by a sub in a module, called by a Form Control) the information was actually entered in the last manually selected sheet and cell.
----Edit----
Running the Showform macro (which calls the form to show) from the Macros button under the developer tab in the ribbon, instead of clicking the Form control button which has the ShowForm macro assigned to it, doesn't create the issue.
----End of Edit----
I then only removed the Form control, and the sub in the module which calls to show the form and placed an ActiveX Control (CommandButton) on the sheet and on the relevant Sheet module created:
Private Sub CommandButton1_Click()
Form.Show
End Sub
Without editing the code any further, there were no further issues regarding information being entered on the last manually selected sheet and cell instead of the sheet and cell the screen was showing as selected.
Edited file (The link will be active for a limited time)
I keep getting this 1004 runtime error. I have slimmed my programing down some so it’s not so Programception. I think it may have to do with using Excel 2010 to save .xls files. Not sure.
When Auto_Root.xls opens it runs Sub auto_open() which opens
Panel.xls
Panel opens and runs Sub Update() which sequentially opens 7 files
in different directories all called Auto_Update.xls
Auto_Update.xsl opens and runs Sub Flat which each open a number of
files sequentially and saves a flat copy of themselves in another
directory.
I have opened each of the 7 Auto_Update.xls files and have run them independently and they run with no errors. When I run them all from Auto_Root I get a runtime error 1004. And CurrentWB.Save is highlighted on one of the files. I even replaced CurrentWB.Save as CurrentWB.SaveAs Filename:=TargetFile, FileFormat:=xlNormal and recieved the same runtime error.
Attached is the code I have.
AutoRoot.xls!Auto Update
Sub auto_open()
Application.CutCopyMode = False
Dim PanelFilePath As String
Dim PanelFileName As String
Dim PanelLocation As String
Dim PanelWB As Workbook
PanelFilePath = "D:\umc\UMC Production Files\Automation Files\"
PanelFileName = "Panel.xls"
PanelLocation = PanelFilePath & Dir$(PanelFilePath & PanelFileName)
Set PanelWB = Workbooks.Open(Filename:=PanelLocation, UpdateLinks:=3)
PanelWB.RunAutoMacros Which:=xlAutoOpen
Application.Run "Panel.xls!Update"
PanelWB.Close
Call Shell("D:\umc\UMC Production Files\Automation Files\Auto.bat", vbNormalFocus)
Application.Quit
End Sub
Panel.xls!Update
Sub Update()
Dim RowNumber As Long
Dim AutoUpdateTargetFile As String
Dim AutoUpdateWB As Workbook
For RowNumber = 1 To (Range("AutoUpdate.File").Rows.Count - 1)
If (Range("AutoUpdate.File").Rows(RowNumber) <> "") Then
AutoUpdateTargetFile = Range("Sys.Path") & Range("Client.Path").Rows(RowNumber) & Range("AutoUpdate.Path ").Rows(RowNumber) & Range("AutoUpdate.File").Rows(RowNumber)
Set AutoUpdateWB = Workbooks.Open(Filename:=AutoUpdateTargetFile, UpdateLinks:=3)
AutoUpdateWB.RunAutoMacros Which:=xlAutoOpen
Application.Run "Auto_Update.xls!Flat"
AutoUpdateWB.Close
End If
Next RowNumber
End Sub
AutoUpdate.xls!Flat
Sub Flat()
Dim RowNumber As Long 'Long Stores Variable
Dim SheetNumber As Long
Dim TargetFile As String 'String Stores File Path
Dim BackupFile As String
Dim CurrentWB As Workbook 'Workbook Stores Workbook
For RowNumber = 1 To (Range("File").Rows.Count - 1)
'Loops through each file in the list and assigns a workbook variable.
If (Range("File").Rows(RowNumber) <> "") Then
TargetFile = Range("Sys.Path") & Range("Path").Rows(RowNumber) & Range("File").Rows(RowNumber) 'Target File Path
BackupFile = Range("Report.Path") & Range("Path").Rows(RowNumber) & Range("SubFolder") & Range("File").Rows(RowNumber) 'Backup File Path
Set CurrentWB = Workbooks.Open(Filename:=TargetFile, UpdateLinks:=3) 'Sets CurrentWB = to that long name. This becomes the name of the workbook.
CurrentWB.RunAutoMacros Which:=xlAutoOpen 'Enables Macros in Workbook
CurrentWB.SaveAs Filename:=TargetFile, FileFormat:=56
For SheetNumber = 1 To Sheets.Count 'Counts Worksheets in Workbook
Sheets(SheetNumber).Select 'Selects All Worksheets in Workbook
If (Sheets(SheetNumber).Name <> "What If") Then
Sheets(SheetNumber).Unprotect ("UMC626") 'Unprotects Workbook
Cells.Select 'Selects Data in Workbook
Range("B2").Activate
With Sheets(SheetNumber).UsedRange
.Value = .Value
End With
Sheets(SheetNumber).Protect Password:="UMC626", DrawingObjects:=True, Contents:=True, Scenarios:=True 'Protects Workbook
End If
Next SheetNumber 'Runs Through Iteration
Sheets(1).Select
Range("A1").Select 'Saves each workbook at the top of the page
CurrentWB.SaveAs Filename:=BackupFile, FileFormat:=56, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False 'Saves Workbook in Flatten File Location
CurrentWB.Close 'Closes Workbook
End If 'Ends Loop
Next RowNumber 'Selects Another Account
End Sub
What I have done so far.
Each Individual AutoUpdate file works when ran on its on.
If Application.Run"Auto_Update.xls!Flat" is removed from Panel.xls!Update it opens and closes all of the AutoUpdate.xls files with no error.
If I link Panel.xls!Update to only 3 of the 7 AutoUpdate files.... any 3. It runs with no errors.
I just can't seem to get it to run all 7 without saying Runtime Error 1004.
I found a microsoft work around code. Not sure how to implement it though.
Sub CopySheetTest()
Dim iTemp As Integer
Dim oBook As Workbook
Dim iCounter As Integer
' Create a new blank workbook:
iTemp = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set oBook = Application.Workbooks.Add
Application.SheetsInNewWorkbook = iTemp
' Add a defined name to the workbook
' that RefersTo a range:
oBook.Names.Add Name:="tempRange", _
RefersTo:="=Sheet1!$A$1"
' Save the workbook:
oBook.SaveAs "c:\test2.xls"
' Copy the sheet in a loop. Eventually,
' you get error 1004: Copy Method of
' Worksheet class failed.
For iCounter = 1 To 275
oBook.Worksheets(1).Copy After:=oBook.Worksheets(1)
'Uncomment this code for the workaround:
'Save, close, and reopen after every 100 iterations:
If iCounter Mod 100 = 0 Then
oBook.Close SaveChanges:=True
Set oBook = Nothing
Set oBook = Application.Workbooks.Open("c:\test2.xls")
End If
Next
End Sub
http://support.microsoft.com/kb/210684/en-us
Based on the document from Microsoft linked below this is a known issue.
Copying worksheet programmatically causes run-time error 1004 in Excel
I'm not sure how many sheets this loop in Flat but it appears that is the issue. Specifically the quote:
This problem can occur when you give the workbook a defined name and then copy the worksheet several times without first saving and closing the workbook
Due to the levels that you have created using separate workbooks I would suggest starting with limiting the scope of your Update subroutine. There are many designs for something like that but I might start with passing an integer argument back and fourth between Auto Open and Update. That way you can close and reopen Panel.xls multiple times and start exactly where you left off.
Its not clear from your text, but is your procedure "Flat" inside the files you are opening and if so is it being called by the auto open macro?
It sounds like you want to only be running your macro from your original workbook, and not firing the ones in the auto open macro of the workbooks you open.
If this is indeed the case, I do something similar in one of my workbooks, where I have an "upgrade" wizard that fires when the work book is opened, however because I am upgrading, the other workbook I open, also has the upgrade wizard, and so that used to fire as well. I resolved this by opening the other workbook in a hidden instance of excel, and within my auto open macro, I have a line of code that queries the visible state of the workbook, and does not fire if it is hidden. So in the below code its the "And Me.Application.visible" that controls if the wizard is run
'Check if the ODS code is populated or default xxx, if so invoke the upgrade wizard
'but only if the application is visible
If (ActiveWorkbook.Names("Trust_ODS_Code").RefersToRange.Value = "xxx" _
Or Len(ActiveWorkbook.Names("Trust_ODS_Code").RefersToRange.Value) = 0) _
And Me.Application.visible = True Then
'run the upgrade wizard
frmCSCWizardv8.Show
End If
This requires that you open your workbooks in a separate excel instance. The below code is the snippet of code that does this, hope this is enopugh for you to get the idea
Dim lRet
Dim i As Integer, j As Integer
Dim FoundSheet As Boolean
'Because the wizard opens the old DCS in a hidden instance of Excel, it is vital that we close this if
'anything goes wrong, so belt and braces, close it every time the user presses the button
'Switch off the error handling and the display alerts to avoid any error messages if the old dcs has
'never been opened and the hidden instance does not exist
Application.DisplayAlerts = False
On Error Resume Next
book.Close SaveChanges:=False
app.Quit
Set app = Nothing
Application.DisplayAlerts = True
'set error handling
On Error GoTo Err_Clr
'populate the status bar
Application.StatusBar = "Attempting to open File"
'Default method Uses Excel Open Dialog To Show the Files
lRet = Application.GetOpenFilename("Excel files (*.xls;*.xlsx;*.xlsm;*.xlsb), *.xls;*.xlsx;*.xlsm;*.xlsb")
'If the user selects cancel update the status to tell them
If lRet = False Then
Me.lstOpenDCSStatus.AddItem "No file selected"
'if the user has selected a file try to open it
Else
'This next section of code creates a new instance of excel to open the selected file with, as this allows us to
'open it in the background
OldDCS = lRet
Application.StatusBar = "Attempting to open File - " & lRet
app.visible = False 'Visible is False by default, so this isn't necessary, but makes readability better
Set book = app.Workbooks.Add(lRet)
Application.StatusBar = "Opened File - " & lRet
In Excel 2007, I have a sheet with a list of other Excel documents, all of which have their own VBA. My code opens the first workbook on the list, lets its vba run, then when it has completed, marks it as complete, and opens the next workbook in the list.
All this works fine unless I let one of the other workboks close itself with 'thisworkbook.close'. This stops the VBA running in the original workbook, as well as itself. If I comment this line out, it all works, but I would rather keep just the master workbook and one sub workbook open at one time.
Also, it is unpractical in this case to move all the VBA to the master workbook.
The code before is a highly simplified version to show the issue:
Workbook1's code:
Sub RunReports()
Dim wkb1 As Workbook
Dim wks1 As Worksheet
Dim lngR As Long
Dim strReport As String
Set wkb1 = ThisWorkbook
Set wks1 = wkb1.Sheets(strDay)
For lngR = 4 To 1048576
strReport = wks1.Cells(lngR, 1).Value
'open the report. Its own VBA will take care of everything else
Workbooks.Open strReport
'mark the report as complete
wks1.Cells(lngR, 2).Value = "done"
Next lngR
End Sub
the code in the worksheets that are opened:
Private Sub Workbook_Open()
ThisWorkbook.Sheets("Sheet1").Cells(1, 1).Value = Now()
ThisWorkbook.Save
Application.Wait (Now() + TimeValue("00:00:05"))
ThisWorkbook.Close
End Sub
If I comment out 'thisworkbook.close', it will open them all, update the time they were opened, and save them. If not, it does everything up to the first 'thisworkbook.close', closes the first sub workbook, and stops all VBA execution.
Does anyone have any ideas how to keep the "master" workbook's vba code running after the "sub" workbook's code has finished, when the 'sub' workbook's code contains a 'thisworkbook.close' (edited to make the question clear)
Use standard COM ways of doing things. Take a reference to each workbook (not excel.application) using GetObject(filename). Do what you want then don't close it in sub book, but set the reference to nothing in your master (which happens when you do set exceldoc = nothing or reach an End Function/Sub). Don't do both as that's voodoo programming.
I am continuing working with data pulled from a mainframe. The data is largely alphanumeric, and is a continuation of building functionality onto past efforts. The loop in which the sheets are moved was created on the basis of the function discussed in this SO article.
I have consulted this SO article and independently tested the general form of such functionality, but such code is failing in this specific case, perhaps due to version issues or the way I am referencing the new workbook.
I have written a subroutine that shifts worksheets from one workbook to another. It is used in conjunction with a public variable tied to a checkbox, and is intended to provide the user with an easy way to port the form data. The public variable is used in a conditional to call the subroutine if the checkmark is in a checked state.
The code is as follows:
Public Sub MoveSheets()
' This macro moves all sheets but those noted within the If statements,(1)
' (1) which are further nested within the For Each loop.
'See http://msdn.microsoft.com/en-us/library/office/ff198017.aspx for save file format types.
'The file format of this excel macro sheet is 52: xlOpenXMLWorkbookMacroEnabled
'The default save type for the use-case is excel 2003 is compatibility mode.
'The macro is to set the current save type to one compatible with 52.
'In this case, 51: xlOpenXMLWorkbook was selected as the selected type.
'Define Excel Format storage variables.
Dim FileFormatSet As Excel.XlFileFormat
Dim OriginalFileFormatSet As Excel.XlFileFormat
Dim TempFileFormatSet As Excel.XlFileFormat
'Define worksheet/workbook variables.
Dim IndividualWorkSheet As Worksheet
Dim NewWorkBook1 As Workbook
'Set variable to store current time.
Dim CurrentTime As Date
'The original file format.
OriginalFileFormatSet = Application.DefaultSaveFormat
'The file format to be used at the end of the procedure after all is said and done.
FileFormatSet = OriginalFileFormatSet
'The currently desired file format.
TempFileFormatSet = xlOpenXMLWorkbook
'The currently desired file format set as the set default.
Application.DefaultSaveFormat = TempFileFormatSet
'Disable application alerts. Comment the line below to display alerts (2)
'(2) in order to help check for errors.
Application.DisplayAlerts = False
'Save new workbook "NewWorkBook" as default file format.
Workbooks.Add.SaveAs Filename:="NewWorkBook", FileFormat:=Application.DefaultSaveFormat
'Set variable to new workbook "NewWorkBook", which is in .xlsx format.
Set NewWorkBook1 = Workbooks("NewWorkBook.xlsx")
'Activate Macro Window.
Windows("ShifterMacro.xlsm").Activate
'For each worksheet, shift it to the workbook "NewWorkBook" if (3)
'(3) it fails outside the criteria set listed below.
For Each IndividualWorkSheet In ThisWorkbook.Worksheets
If IndividualWorkSheet.Name <> "Sheet1" And IndividualWorkSheet.Name <> "Criteria" And _
IndividualWorkSheet.Name <> "TemplateSheet" And IndividualWorkSheet.Name <> "TemplateSheet2" And _
IndividualWorkSheet.Name <> "Instructions" And IndividualWorkSheet.Name <> "Macro1" And _
IndividualWorkSheet.Name <> "DataSheet" Then
'Select each worksheet.
IndividualWorkSheet.Select
'Shift the worksheetover to the new workbook.
'****NOTE: THIS CODE CURRENTLY RESULTS IN A '1004' RUN-TIME ERROR.****
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count
End If
Next
'An ugly set of If Then statements to clean the new workbook (4)
'(4) of its previous sheets, assuming entries are to be made.
If NewWorkBook1.Sheets.Count > 1 Then
NewWorkBook1.Sheets("Sheet1").Delete
End If
If NewWorkBook1.Sheets.Count > 1 Then
NewWorkBook1.Sheets("Sheet2").Delete
End If
If NewWorkBook1.Sheets.Count > 1 Then
NewWorkBook1.Sheets("Sheet3").Delete
End If
'********** CODE CHECKED BUT UNTESTED WITHIN THESE BOUNDARIES **********
'Activate the Window for the new workbook if it is inactive.
Windows("NewWorkBook.xlsx").Activate
'If the number of sheets are greater than 1... (5)
If Sheets.Count > 1 Then
'(6) The time value is parsed to remove unusual characters, following (5)
'(6) the logic of this SO article: https://stackoverflow.com/questions/11364007/save-as-failed-excel-vba.
'Formatted current time as per http://www.mrexcel.com/forum/excel-questions/273280-visual-basic-applications-format-now-yyyymmddhhnnss.html
CurrentTime = Format(Now(), "yyyy-mm-dd-hh-nn-ss")
'(5) Then go ahead and save the file with the current date/time information.
NewWorkBook1.SaveAs Filename:="Form_Data_" & Now, FileFormat:=Application.DefaultSaveFormat
End If
'Set SaveChanges = True, as per https://stackoverflow.com/questions/9327613/excel-vba-copy-method-of-worksheet-fails
ActiveWorkbook.Close SaveChanges:=True
'********** END CODE BOUNDARY **********
'Activate the Window for the Macro.
Windows("ShifterMacro.xlsm").Activate
'Activate a specific sheet of the Macro.
ActiveWorkbook.Sheets("Instructions").Activate
'Change Display Alerts back to normal.
Application.DisplayAlerts = True
'Reset the view for the original data sheet.
With Sheets("Sheet1")
'For when this process is repeated.
If .FilterMode Then .ShowAllData
End With
'Return the Default save format to the original file format.
Application.DefaultSaveFormat = FileFormatSet
End Sub
The code fails at line 62, and results in a '1004' Run-Time error:
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count
The worksheet referenced holds the correct test value of '100-AAA'. The Sheets.Count is equal to 3. The NewWorkBook1 variable holds the value NewWorkBook.xslx. The path of the generated workbook "NewWorkBook.xslx" is the same as the macro workbook. My version of excel is 2007, although the default for my users is 2003, even though they have the capacity and the installation for 2007.
Why is this run-time error with my Move occuring, and how do I correct this error in order to get my worksheets over to the newly generated workbook?
This:
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count
just specifies to move the sheet within the same workbook (and it will error if NewWorkBook1 has more sheets than its parent workbook)
Maybe try:
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets(NewWorkBook1.Sheets.Count)