I have an import code that works perfectly on my 2013 64bit excel; however, I have users that are using 2010 Excel with 32bit and the code does not work. I would be very grateful if someone would look at the below code and tell me what I need to change in order for my 2010 32bit users to be able to use it:
Sub TransferData()
''<<<<unprotect code
Dim i As Integer
For i = 1 To Sheets.Count
Sheets(i).Unprotect password:="ADMIN"
Next i
'
''<<<<<main code
'
Application.ScreenUpdating = False
Sheets("Dashboard").Activate
Sheets("DASF Data").Range("DASF_Range").ClearContents
'
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = ActiveWorkbook
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.xls (*.xls),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
For Each Sheet In wb2.Sheets
If Sheet.Visible = True Then
Range("A2:Y10000").Select
Selection.Copy
Windows("DASF MANAGEMENT TOOL (CONUS Ver 1.0).XLSB").Activate
Sheets("DASF Data").Select
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Dashboard").Activate
End If
Next Sheet
End If
Workbooks("DASF.XLS").Close SaveChanges:=False
End Sub
That error number does not necessarily have anything specifically to do with your listed code. It could be an error anywhere in your modules: or it could be corrupt code in the compiled version of one of your modules. It could even be a broken library reference.
To exclude the first possibility, do a manual "compile all' of your code.
To fix the second possibility, create a new spreadsheet, and copy the text from your old spreadsheet into new modules in your new spreadsheet. Or download and use an Excel 'decompiler'.
Related
So the user is able to import data from another excel file and I want to close the other excel file once the values have been copied into the current workbook. I can't, however, get my code to go back and select the other excel file in order to close it again.
I've already checked and it's only running one instance of Excel.
Option Explicit
Private Sub Button_ImportSubmittedData_Click()
Dim MyFile As String
Dim tempDataSetName As String
tempDataSetName = "Submitted Apps"
MyFile = Application.GetOpenFilename("Excel Files,*.xlsx")
Workbooks.OpenText Filename:=MyFile
ActiveSheet.Range("A2").Select
ActiveSheet.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Windows("HET.xlsm").Activate
Sheets("Submitted").Select
ActiveSheet.Range("A2").Select
ActiveSheet.Paste
Selection.Columns.AutoFit
ActiveSheet.Range("A1").Select
**Windows(MyFile).Activate**
'Application.DisplayAlerts = False
'ActiveWindow.Close
'Windows("HET.xlsm").Activate
'ActiveSheet.Range("A1").Select
End Sub
I tried to read up a few related posts on the forum but wasnt able to make a code work or understand the syntax of a few functions.
I will try to describe what I want to be done in a crisp fashion:
I have a workbook with the multiple sheets (Sheet1, Sheet2 ... Sheet 5) and I want to create a macro assigned button to Save as a new work book containing only Sheet 1, Sheet 2 and Sheet3
The file format should be Microsoft Excel 97-2003 Worksheet (.xls)
On clicking the Macro assigned button the Save as dialogue box should pop up allowing the user to select destination and also optionally a new file name (pre assigned file name can be "textstring123"
After the workbook is saved the workbook should open for user to inspect while the old workbook is minimised
I am using Excel 2013, in case that is relevant.
The post may seem crude but I have no choice but to seek help from you as I have been breaking my head over this for the last day and a half and without this the rest of my macro project will become a waste. Thank you in advance for and suggestion/advice/ help.
If any other details or clarification is required please do ask.
I have added my lines of code that I have made but doesnt seem to work properly.
Sub Macro6()
'
' Macro6 Macro
' Save as
''
Dim varResult As Variant
Sheets(Array("sheet1", "sheet2", "sheet3")).Copy
varResult = Application.GetSaveAsFilename(FileFilter:= _
"Excel Files *.xls", FileFormat:=-57, Title:="Save File", _
InitialFileName:=ActiveWorkbook.Path \ Textstring123.xls)
If varResult <> False Then
ActiveWorkbook.SaveAs Filename:=varResult, _
FileFormat:=xlWorkbookNormal
Exit Sub
End If
End Sub
This will do the trick, I have an issue with the Filters so I added a bit of error handling!
Option Explicit
Sub Macro6()
'
' Macro6 Macro
' Save as
''
Dim tB As Excel.Workbook
Dim wB As Excel.Workbook
Dim ExportArray As Variant
Dim ShName As Variant
Dim ExportName As String
Dim varResult As Variant
Set tB = ThisWorkbook
ExportArray = Array("sheet1", "sheet2", "sheet3")
For Each ShName In ExportArray
Debug.Print ShName
tB.Sheets(ShName).Copy
Set wB = ActiveWorkbook
On Error Resume Next
ExportName = Application.GetSaveAsFilename(tB.Path & "\Textstring123", "Excel Files *.xls", , "Save " & ShName)
If Err.Number > 0 Then
ExportName = Application.GetSaveAsFilename(tB.Path & "\Textstring123", , , "Save " & ShName)
Else
'No error, everything went well with filters
End If
On Error GoTo 0
'String 8 and Boolean 11
If VarType(ExportName) <> 8 Then
Exit Sub
Else
wB.SaveAs Filename:=ExportName, FileFormat:=xlWorkbookNormal
End If
DoEvents
wB.Close
Next ShName
End Sub
I have the following code in a macro in my personal book, and it works perfectly.
I'm trying to copy it into the actual wb it's running from so I can send it around for others to use, and it's breaking at the commented line "XXXXXX". The selected wb is being opened fine, but none of the subsequent editing occurs to that book. All of the following code (deletion of columns, etc) that should be happening to the opened workbook only happens to the wb running the macro, which is...sub-optimal.
I don't know why! Any thoughts welcomed.
Thank you
Sam
Sub PredictBoxValue()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim TitleName As String
Dim sas As String
Dim sos As String
Dim unusedRow As Long
Dim filename As String
'Optimize Macro Speed
Application.ScreenUpdating = False
'Application.EnableEvents = False
'Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
sos = ActiveWorkbook.Name
ActiveSheet.Range("B11", "AF11").Clear
Dim fNameAndPath As Variant
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS),
*.XLS", Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Set wb = Workbooks.Open(fNameAndPath)
sas = ActiveWorkbook.Name
'Delete extraneous columns and rows
'XXXXXXXXXXX
TitleName = Cells(5, 2).Value
Columns(8).Delete
Columns(12).Delete
Columns(12).Delete
Columns(3).Delete
Columns(2).Delete
Columns(1).Delete
Rows(3).Delete
Rows(2).Delete
Rows(1).Delete
Here:
Do Until Cells(2, 1).Value = "1"
Range("A1").End(xlDown).Select
'Do Until ActiveCell.Value = "1"
'ActiveCell.Offset(1).Select
'Loop
Do While ActiveCell.Value < 1
ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
Loop
ActiveCell.Offset(-1, 1).Select
Do While ActiveCell.Offset(0, -1).Value > 30
ActiveCell.EntireRow.Delete
GoTo Here
Loop
ActiveCell.Resize(, 7).Cut ActiveCell.Offset(1, 0).End(xlToRight).Offset(0,
1)
ActiveCell.EntireRow.Delete
Loop
Rows(1).EntireRow.Delete
Cells(1, 1) = TitleName
Range("A1", Range("A1").End(xlToRight)).Copy
Windows(sos).Activate
ActiveSheet.Cells(11, 2).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Windows(sas).Activate
'Save and Close Workbook
wb.Close SaveChanges:=False
Windows(sos).Activate
ActiveSheet.Cells(5, 3).Select
'Message Box when tasks are completed
MsgBox ("Data uploaded for ") & Range("B11")
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
I took a bit of a closer look at your code. I think you are saying that you want to run code from macros.xlsm (or something like that), and have it operate on mydata.xlsx (or some such). Therefore, in your macro, ThisWorkbook will refer to macros.xlsm (should you need to refer to that).
After you have done Set wb = Workbooks.Open(fNameAndPath) to open mydata.xlsx, only and always refer to wb and wb.Sheets("whatever") when you are talking about mydata.xlsx.
Don't use Columns, Rows, Sheets, or Cells without a sheet reference in front of them
Don't use ActiveWorkbook/ActiveWorksheet at all.
Instead of ActiveCell, use a named range, e.g., as in this answer to the question BruceWayne noted.
That should take care of it!
<soapbox>And, in general, please be careful of your indentation and use longer variable names — both will help you avoid bugs as you work on this code.</soapbox>
i've searched multiple forums to see if i can discover why a peice of code isnt working but havent found an answer yet.
My VBA isnt great and i inherited this section of code from a predecessor.
This part of the code saves each indivisual worksheet as a new workbook by using the worksheet names.
Dim NewBook As Workbook, OldBook As Workbook, sh As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set OldBook = ThisWorkbook
For Each sh In OldBook.Worksheets
If sh.Visible = True Then
sh.Copy
ActiveWorkbook.SaveAs Filename:="Pathway" & "\" & sh.Name, FileFormat:=xlExcel8
ActiveWorkbook.Close
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.Close False
This works fine and will create the sheets for me but I now need to add to the file name by using the same cell value from each worksheet (B1) so i tried adding to the code.
ActiveWorkbook.SaveAs Filename:="Pathway" & "\" & sh.Range("B1").Value & sh.Name, FileFormat:=xlExcel8
However doing so results in a "Run-time error '1004': There is no active Protected View Window" but i'm not too sure why that would be?
Any help here would be much appreciated.
This is likely due to your path not being a string accepted by Windows as file name. As the problem appears when you add B1 to the path, this seems to be the source of your problem. Check if cell B1 contains any characters not allowed in file names.
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