Moving Worksheets to Newly Created & Version Changed Workbook VBA - vba

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)

Related

Excel -Run Time Error 1004 'Application Defined or Object Defined Error'

I have an Excel 2003 spreadsheet ("Tune.xls") with some VBA. It always fails with error:
Run Time Error 1004 'Application Defined or Object Defined Error'
When I click debug it brings me to the following line in the code :
DataImport.Range("J10").Value = FileName 'Copy path and filename to worksheet "Import Data"
and also please look into whole code as follows:
'Ensure that all global (public) flags are initialized properly; they might have been
'changed before the user requested a data import.
Sub_Error = False
Changed_Model_1 = False
Changed_Model_2 = False
Plot_Model_1 = False
Plot_Model_2 = False
Updated_Model_1 = False
Updated_Model_2 = False
'Disable screen updating to avoid flicker when graph data is modified. Puting the focus away
'from the graph to worksheet "Data Import" speeds up the execution by a factor of about 4. This trick
'is ad hoc and I cannot explain why it works, but it does...
Application.ScreenUpdating = False
DataImport.Select
'Open window to select data file. If no file is opened, then the variable FileName will be false.
FileName = Application.GetOpenFilename("Text Files (*.txt; *.dat),*.txt;*.dat, Excel Files (*.xls),*.xls", , "Open Process Data File")
If FileName = False Then Exit Sub 'exit if no file was opened or cancel button selected
******DataImport.Range("J10").Value = FileName 'Copy path and filename to worksheet "Import Data"******
'Open data file as a workbook and use shortcut name "DataSheet" for worksheet containing data.
Workbooks.Open FileName:=FileName, updateLinks:=0 'does not update linked cells
Set DataSheet = ActiveWorkbook.ActiveSheet
Set DataBook = ActiveWorkbook 'use shortcut for Data workbook
'The data workbook might contain cells referencing a DDE link. This makes it hard to manipulate
'the cells. Therefore, the entire worksheet is copied and only the values are pasted back. This
'will essentially remove all the DDE references.
DataSheet.Cells.Select 'This selects all cells
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Please can somebody help me to get this working again?
1004 is an error which can come because of various reasons. In general, it may be because:
some of the objects are not defined correctly;
the worksheet is locked;
Thus, to check the first option write these two lines before the error:
MsgBox Filename
MsgBox DataImport.Name
and see what you get. You should get something for Filename (not an error) and the DataImport.Name should be the name of the sheet.
Concerning the second option - check whether the cells in DataImport are not locked.

When I create a new Workbook and add sheets to it using another Workbook, the sheets appear in the workbook window but VBA does not recognize them

So what I am trying to do is to create a new workbook every year. A new workbook gets created if there is data from two different years in a certain worksheet of the workbook. When it sees two different years, it creates a new workbook, imports the .bat file into the new workbook, then pastes the information from the new year into the new workbook from the old workbook. Then it adds three more sheets and names them the same way they were named in the old workbook. The problem I am running into is when I run the macro for the new workbook, it says that "Sheet2" is Empty and then throws an error. I know all 4 sheets are there because I see them being added when I have trued to debug the code. But when I go into the VBA editer, all I see under the Microsoft Excel Objects folder is "Sheet1(...) and ThisWorkbook. It should show "Sheet1(...)","Sheet2(...)","Sheet3(...)", and "Sheet4(...)". So something is not being transferred into the VBA editor from the new workbook.
I have tried transferring the old data into another workbook and importing the macro to see if it was workbook specific (it wasn't). I have tried creating a loop to activate each sheet when it runs the macro in the new workbook to see if VBA would recognize it then, and adding a delay before and after I save the new workbook after all the sheets are added using the old workbook macro:
I am trying to avoid having to majorly rewrite it.
Sub NewYearNewFile(WashN As Variant, savepathname As String, FileYearNumber As Variant) 'This sub is to avoid crossover of data from multiple years in one spreadhseet
'After copy and paste is complete, then compare the years on sheet one and copy next years data over to a new worksheet--------
Dim NextRow As Integer, FinalColumn As Integer, FinalYear As String
Dim i As Long, newworkbook As Workbook, NextRow4 As Integer
Dim VBProj As Object
Dim savepath As String
Dim FileName As String
Sheet1.Activate 'activates sheet 1
NextRow = Cells(Rows.Count, 1).End(xlUp).Row 'Find the last row# of important data
FinalColumn = Cells(1, Columns.Count).End(xlToLeft).Column 'finds the rightmost column
FinalYear = Year(Sheet1.Cells(NextRow, 1).Value) 'finds the year in the final row and uses this for the new filename
NextRow4 = Sheet4.Cells(Rows.Count, 1).End(xlUp).Row 'Find the last row# of important data
'the folderpath of the Master Macro File (used when createing a new excel file)
Dim MMacroFilePath As String 'defines and states the filepath of the stored macto to import
MMacroFilePath = "L:\MCP\Conformal Coat & Wash\Aquastorm50\DataLogs\Compiled data" & _
"\Automated Files\THE ULTIMATE MACRO.bas" 'the macro filepath
FileName = "Wash " & WashN & " Data " & FinalYear & ".xlsm" 'saved filename format
savepath = savepathname & FileName 'complete file path of the saved excel file
'Compare the final year of recorded data to the year number in the filename. If they are not the same, do the following.
'If they are the same, do nothing and finish the copy and paste portions of the code.
If FinalYear <> FileYearNumber Then
'Go to the row 200 before the last one, and begin comparing dates.
For i = NextRow - 200 To NextRow 'from 200 lines up from the bottom to the bottom row
If Year(Sheet1.Cells(i, 1).Value) <> CInt(FileYearNumber) Then 'if the year in this row doesnt match the file name year
Cells(i, 1).Resize(NextRow - i + 1, FinalColumn).Cut 'cut this row and all rows below it
Set newworkbook = Workbooks.Add 'create a new workbook
newworkbook.Activate 'activate this workbook
Set VBProj = Nothing 'clearing the variable
Set VBProj = ActiveWorkbook.VBProject 'defines the variable
VBProj.VBComponents.Import MMacroFilePath 'imports this macro into the new workbook
With newworkbook
.Sheets("Sheet1").Paste 'pastes it to the first sheet in the new file
.Sheets("Sheet1").Rows(1).EntireRow.Insert 'adds a new row for headers when they get inserted later
.Sheets(1).Name = Sheet1.Name
.Sheets.Add 'add sheet2 to the workbook
.Sheets(1).Name = Sheet2.Name
.Sheets.Add 'add sheet3 to the workbook
.Sheets(1).Name = Sheet3.Name
.Sheets.Add 'add sheet4 to the workbook
.Sheets(1).Name = Sheet4.Name
End With
GoTo CCheck: 'tells the code to skip looping and goto the end of the sub
End If
Next i
'This moves any data from the Chem Check sheet to the new workbook
CCheck: 'once the data from sheet one moves over, the code goes here
For i = NextRow4 - 8 To NextRow4 'from 8 lines up from the bottom to the bottom row
If IsDate(Sheet4.Cells(i, 1).Value) And Year(Sheet4.Cells(i, 1).Value) <> CInt(FileYearNumber) Then 'if the year in this row doesnt match the file name year
Sheet4.Cells(i, 1).Resize(NextRow4 - i + 1, FinalColumn).Cut 'cut this row and all rows below it
newworkbook.Activate 'activate the new workbook
With newworkbook
.Sheets("sheet4").Paste 'pastes it to the fourth sheet in the new file
.Sheets("Sheet4").Rows(1).EntireRow.Insert 'adds a new row for headers when they get inserted later
End With
GoTo Finish: 'tells the code to skip looping and goto the end of the sub
End If
Next i
Finish: 'the code goes here after it reachers "Goto Finish:"
Application.Wait Now + #12:00:01 AM#
newworkbook.SaveAs savepath, 52 'saves new file with the Filepath for the new spreadsheet (52 means ".xlsm")
Application.Wait Now + #12:00:01 AM#
newworkbook.Close 'closes the new workbook
End If
End Sub
.Sheets.Add 'add sheet4 to the workbook
.Sheets(1).Name = Sheet4.Name
Sheets.Add is a function that returns a reference to the added sheet - you're discarding it. Instead, you need to capture it. Declare a Sheet4 variable of type Worksheeet, and set its reference:
Dim Sheet4 As Worksheet
Set Sheet4 = .Sheets.Add
The problem is that you're assuming that the compiler can understand what's happening at run-time.
It doesn't. The compiler doesn't care about what happens at run-time, it only knows about code and objects that exists at compile-time. The VBA runtime/interpreter cares about run-time.
If Sheet4 doesn't exist at compile-time, then VBA doesn't define a global-scope Sheet4 object variable for you, so referring to Sheet4 in code will inevitably result in code that can't be compiled (and thus can't be executed), at least if Option Explicit is specified.
Without Option Explicit, what's happening is quite more complex.
I presume you're getting an "Object required" run-time error, on the first instruction that refers to any member of a worksheet object that you've created at run-time.
The reason is because without Option Explicit, at compile-time there's no identifier validation, so any typo will happily be compiled. At run-time, when VBA encounters an undeclared variable, it simply defines one on-the-spot, as an implicit Variant that can hold literally anything. Except it won't go as far as to infer that this on-the-fly variable is an object with members - so the runtime blows up and says "I've no idea what this is, it should be an Object, but I'm looking an a Variant/Empty".
TL;DR: Specify Option Explicit, and declare a variable for every identifier the compiler complains about (via the Debug ~> Compile VBAProject menu), until the code compiles correctly.
The global object variables (e.g. Sheet1, Sheet2, etc.) you're assuming "come for free with every worksheet" only exist if the object exists at compile-time.

Copying a sheet to same Excel workbook is giving error - subscript out of range

Copying a sheet to same Excel workbook is giving error - subscript out of range.
sub copyWorkSheet()
Dim myPath As String
myPath = Application.ActiveWorkbook.FullName
Workbooks("Generator.xlsm").Activate
Sheets("Details 1").Select
Sheets("Details 1").Copy After:=Workbooks(myPath).Sheets("Details 2")
End Sub
There are a number of lines where the error may be occurring:
Workbooks("Generator.xlsm").Activate
Make sure "Generator.xlsm" is open - activate makes 'Generator' the active and available workbook, but will not open it for you.
You must also ensure 'Details 1' and 'Details 2' exist in both workbooks, this will also create an error if they do not.
Example corrected code:
Sub copyWorkSheet()
Set otherWorkbook = Application.Workbooks.Open("Generator.xlsm")
otherWorkbook.Activate
otherWorkbook.Sheets("Details 1").Select
otherWorkbook.Sheets("Details 1").Copy After:=Application.ThisWorkbook.Sheets("Details 2")
End Sub
This snippet assumes
You want to copy into 'ThisWorkbook" - the workbook associated with the vba
Both workbooks contain "Details 1" and "Details 2"
"Generator.xlsm" will remain open after this code runs.
Your problem is caused by this line:
myPath = Application.ActiveWorkbook.FullName
which returns the name of the object, including its path on disk
To address an item within the Workbooks collection you can use its Name property which doesn't include its path. Changing the above line to:
myPath = Application.ActiveWorkbook.Name
will solve your problem provided the ActiveWorkbook does contain a sheet named Detail 2.
That said, you should try to avoid using ActiveWorkbook because it may not be the workbook that you think it is. Assuming you want to copy into the workbook where the Sub is saved, it would be safer to refer to ThisWorkbook.Name.

Excel Userform VBA VLOOKUP from intranet file (2)

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?

Inserting column in Excel 2013 Add In fails with Error 438

I would appreciate help solving this vexing problem with inserting a column into a worksheet with VBA. The worksheet is generated from a database. I need to insert a column into the worksheet for data that is not part of the database. The project takes the data from the worksheet and writes it to a series of Word forms. The code works fine when run from a module in the macro enabled worksheet. When I use the code in an Add-In (.xlam) it doesn't insert the column and an Error 438 is captured by Err.Number. When I put the module in a separate workbook and run it, the column is inserted but the error is still captured. I've tried a lot of the suggestions for debugging and fixing my code to run properly in an add-in. The add in is signed with a valid certificate which should allow it to run on our network.
I started using the .EntireColumn.Insert but switched to Selection.Insert to see it that would work. Both versions fail to insert the column. I also changed the code to create a specific reference to the target worksheet instead of relying on ActiveWorkbook or Activesheet.
Edit: The worksheets are not protected.
I was using #Rory method for Excel VBA Add In Control.
I tried #ErikEidt's answer to Standalone code for Excel to use a button on the Excel Quick Access Toolbar to run the Add-In.
I still get the error message but the code exectues and the column is inserted successfully.
Here is the relevant extract of my code.
Option Explicit
Sub FormfromExcell()
'Note:Requires Reference to Microsoft Word and Excel(15.0 for 2013)Object Library set in Tools>References
'DECLARE AND SET VARIABLES
' Excel Objects
Dim WBA As Workbook 'The Active workbook
Dim WBAname As String
Dim wksht As Worksheet 'Excel Worksheet
Dim shtName As String
Dim myLastRow As Long
Dim myLastCol As Long
' Initialize the Excel Objects
Set WBA = ActiveWorkbook 'The workbook that calls the Add-In
WBAname = ActiveWorkbook.Name
shtName = WBA.Worksheets("Dynamic Risk Report").Name
Set wksht = WBA.Worksheets("Dynamic Risk Report")
'Set wksht = Workbooks("WBAname").Worksheets("shtName")
Application.StatusBar = "Checking for Status and Action Columns"
' Check for presence of non-database columns (Action and Status) and insert them if not there.
If wksht.Cells(1, "D") = "Action" Then GoTo Checkforstatus
'wksht.Range("D1").EntireColumn.Insert
wksht.Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
If Err.Number <> 0 Then MsgBox "Error" & Err.Number
wksht.Cells(1, "D").Value = "Action"
Checkforstatus:
'Rest of code
If you can eliminate the Select and just do a straight insert, will that work?
Also you try defining your own constants, just in case Add-In doesn't have access - even though that doesn't make sense to me, seeing as you're runnign this from Excel
Const xlToRight = -4161
Const xlFormatFromLeftOrAbove = 0
Dim rge As Range
Replace this:
wksht.Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
With this
Set rge = wksht.Columns("D:D")
rge.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove