This is intended to be a daily macro that run to update a report. This file would need to overwrite the existing file daily. However, the Application.DisplayAlerts = False is not working and I still get the pop up saying that this file already exists and if I want to replace. Is there something wrong with my code or is there a workaround to use a method that would automatically click yes for me?
Sub DailyRefresh ()
'Open and refresh Access
Dim appAccess As Object
Set appAccess = GetObject("S:\Shared\DailyRefresh.accdb")
Application.DisplayAlerts = False
appAccess.Visible = True
appAccess.DoCmd.RunMacro "Run_All_Queries"
appAccess.CloseCurrentDatabase
'Open Excel
Set xl = CreateObject("Excel.Application")
xl.Workbooks.Open ("s:\Shared\Template.xlsx")
xl.Visible = True
Application.DisplayAlerts = False
'Set date to the 1st of the Month on Summary tab
xl.Sheets("Summary").Visible = True
xl.Sheets("Summary").Select
xl.Range("C10").Value = DateSerial(Year(Now), Month(Now), 1)
xl.Range("C10").NumberFormat = "mm/dd/yyyy"
' REFRESH Table
xl.Sheets("Data").Visible = True
xl.Sheets("Data").Select
xl.Range("A1").Select
xl.Range("DailyRefresh.accdb[[#Headers],[ACTIVITY_DT]]").Select
xl.Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
xl.Worksheets("Fname").Visible = True
xl.Sheets("Fname").Select
'Copy and Save AS
Application.DisplayAlerts = False
Path = "S:\Shared\NewTemplate"
Filename = xl.Sheets("Fname").Range("A7").Value
xl.SaveAs Path & Filename & ".xlsx", FileFormat:=51, CreateBackup:=False
xl.Worksheets("Fname").Visible = False
xl.Close
Application.DisplayAlerts = True
End Sub
Application.DisplayAlerts = False
refers to the application where your code is running, not the Excel instance you created.
xl.DisplayAlerts = False
would be what you want.
I propose you to use Application.DisplayAlerts = False exactly before the line(s) that are taking time (no other lines between them). I had the same problem, because I was using it just once, but after each line that calls an external app, when it is back to VBA, it goes back to true.
Related
I am trying to dismiss pop up password boxes while my macro is running, each file is password protected which i have code for to unlock these however the files also are linked to other password protected files that excel prompts me for a password, instead of clicking cancel every time one of these boxes pops up is there a way to dismiss the password boxes in the macro?
Here is my current code:
Sub OpenCurrentGBP()
cdirectory = Range("E5").Value
Mdirectory = Range("E6").Value
cGap = Range("E11").Value
cEVE = Range("E12").Value
cHedge = Range("E13").Value
cVarFile = Range("E16").Value
cGapMovements = Range("E17").Value
cQRMCheck = Range("E18").Value
GapPwd = Range("E42").Value
EVEPwd = Range("E43").Value
HedgePwd = Range("E44").Value
EurogapPwd = Range("E45").Value
EuroEVEPwd = Range("E46").Value
VarPwd = Range("E47").Value
MovPwd = Range("E48").Value
Application.DisplayAlerts = False
Call OpenFile(cdirectory, cGapMovements, MovPwd)
Call OpenFile(cdirectory, cGap, GapPwd)
Call OpenFile(cdirectory, cEVE, EVEPwd)
Call OpenFile(cdirectory, cHedge, HedgePwd)
Call OpenFile(cdirectory, cVarFile, VarPwd)
Call OpenFile(cdirectory, cQRMCheck)
Application.DisplayAlerts = True
End Sub
The OpenFile Macro is as follows:
Sub OpenFile(Directory, File, Optional Pass)
On Error GoTo Failure
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
If IsMissing(Pass) = 0 Then
Workbooks.Open Filename:= _
Directory & "\" & File, Notify:=False, Password:=Pass
Else
Workbooks.Open Filename:= _
Directory & "\" & File, Notify:=False
End If
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
Exit Sub
Failure: MsgBox (File & " could not be opened")
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
End Sub
Inside the subs you call (Next time you should show them here too) to open the protected Workbooks you need to use the Workbooks.open statment and I have an example of my own codes that I am using to open workbooks with password:
Workbooks.Open Filename:=tmp_file_p, Password:="7399"
tmp_file_p is a string variable with the path and the name of the workbook.
I have a csv file which has column D with dates entered and formatted under the australian date format. The rest of data is integers:
4/10/2016 (correctly representing 4 Oct 16)
15/03/2017 (correctly representing 15 Mar 17)
When I save this file manually as xlsx it correctly saves the dates so when I reopen the xlsx file the dates appear correctly:
value = 4/10/2016, format = 4/10/2016 (as dd/mm/yyyy)
value = 15/03/2017, format = 15/03/2017 (as dd/mm/yyyy)
However, when I do the same thing programmatically:
fileNameXLSX = "H:\20160930.xlsb"
fileNameCSV = "H:\20160930.csv"
Set srcBook = Application.Workbooks.Open(filenameCSV, ReadOnly:=True)
Application.DisplayAlerts = False
srcBook.SaveAs filename:=fileNameXLSX, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
srcBook.Close False
Set srcBook = Nothing
Application.DisplayAlerts = True
and open the file, some entries, months/dates get swapped and in that xlsx file those values will become:
value = 10/4/2016, format = 10/4/2016 (still dd/mm/yyyy)
value = 15/03/2017, format = 15/03/2017
I'm in the australian windows locale. How can I fix this so my VBA code does what I expect it to do.
I would try setting local to true, this should keep the date in the desired format. In your code this would look like this:
fileNameXLSX = "H:\20160930.xlsb"
fileNameCSV = "H:\20160930.csv"
Set srcBook = Application.Workbooks.Open(filenameCSV, ReadOnly:=True)
Application.DisplayAlerts = False
srcBook.SaveAs filename:=fileNameXLSX, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False, Local:=True
srcBook.Close False
Set srcBook = Nothing
Application.DisplayAlerts = True
Source: https://msdn.microsoft.com/en-us/library/office/ff841185.aspx
I would recommend to set the Local parameter to True in the Open command if the dates in the csv are not American.
fileNameXLSB = "H:\20160930.xlsb"
fileNameCSV = "H:\20160930.csv"
Set srcBook = Application.Workbooks.Open(filenameCSV, ReadOnly:=True, local:=True)
Application.DisplayAlerts = False
srcBook.SaveAs Filename:=fileNameXLSB, FileFormat:=xlExcel12, CreateBackup:=False
srcBook.Close False
Set srcBook = Nothing
Application.DisplayAlerts = True
I would recommend as a simple solution to add a line of code that selects the column with the dates in it and sets their number format to the convention you prefer- this would look something like this:
fileNameXLSX = "H:\20160930.xlsb"
filenameCSV = "H:\20160930.csv"
Set srcBook = Application.Workbooks.Open(filenameCSV, ReadOnly:=True)
Application.DisplayAlerts = False
srcBook.SaveAs Filename:=fileNameXLSX, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
srcBook.Sheets(1).Columns("A:A").EntireColumn.NumberFormat = "d/mm/yyyy"
srcBook.Close False
Set srcBook = Nothing
Application.DisplayAlerts = True
Hope this helps,
TheSilkCode
I had this same issue, it was the 2nd option to fix for me, local = True must be set when opening the file, not when saving it
(Sorry can't add comments yet)
I need to set password for multiple excel sheets in vba. I have a excel document with sheets for different company sections. I want that when I open excel document that only start page is shown, and then when I eneter password , if it is correct, then to open only two sheets for that section. Idea is:
Open excel document, start page is shown.
Enter password for one of the 6 sections
If password for section1 or section 2 ... or section 4 is correct, show two sheets that belongs to section for which we entered password.
If password for section5 or section 6 is correct, then show all sheets. I've tried first to lock one sheet with this code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim xSheetName As String
xSheetName = "Sheet1"
If Application.ActiveSheet.Name = xSheetName Then
Application.EnableEvents = False
Application.ActiveSheet.Visible = False
xTitleId = "KutoolsforExcel"
response = Application.InputBox("Password", xTitleId, "", Type:=2)
If response = "123456" Then
Application.Sheets(xSheetName).Visible = True
Application.Sheets(xSheetName).Select
End If
End If
Application.Sheets(xSheetName).Visible = True
Application.EnableEvents = True
End Sub
Problem with this whenever I click on other sheet and then click back to sheet1 it asks for password ( becouse of
`If Application.ActiveSheet.Name = xSheetName Then
Application.EnableEvents = False
Application.ActiveSheet.Visible = False`
I suppose, but I don't know how to avoid it.
Then , when I tried to lock multiple sheets like this :
Dim xSheetName1 as String
Dim xSheetName3 as String
xSheetName1 = "Sheet1"
xSheetName3 = "Sheet3"
If Application.ActiveSheet.Name = xSheetName1 Then
Application.EnableEvents = False
Application.ActiveSheet.Visible = False
xTitleId = "KutoolsforExcel"
response = Application.InputBox("Password", xTitleId, "", Type:=2)
If response = "123" Then
Application.Sheets(xSheetName1).Visible = True
Application.Sheets(2).Visible = True
Application.Sheets(xSheetName1).Select
If Application.Sheets(1).Visible = True Then
Application.EnableEvents = False
Aplication.Sheets(xSheetName1).Visible = False
Exit Sub
End If
End If
End If
If Application.ActiveSheet.Name = xSheetName3 Then
Application.EnableEvents = False
Application.ActiveSheet.Visible = False
xTitleId = "KutoolsforExcel"
response = Application.InputBox("Password", xTitleId, "", Type:=2)
If response = "111" Then
Application.Sheets(xSheetName3).Visible = True
Application.Sheets(5).Visible = True
Application.Sheets(5).Select
If Application.Sheets(1).Visible = True Then ' tried to get rid of asking
for password every time
Application.EnableEvents = False
' Aplication.Sheets(xSheetName1).Visible = False
Exit Sub
End If
End If
End If
Application.Sheets(xSheetName1).Visible = True
Application.Sheets(xSheetName3).Visible = True
Application.EnableEvents = True
End Sub
then when I enter any correct password all locked sheets are unlocked.
Sometimes I've used Sheets(index) because for some sheets names error 9 makes problem :)))
I agree with batman, this is not a very secure way of doing this. Best to have this as a master file, and run the macro to split the sheets into multiple files with password.
This way you can still edit contents with 1 file, and still manage the security within 1 file.
I have one table in the database sheet in which i would want to paste link to another sheet. However i realised that it is not possible using excel and vba. Is there any ways to reference these tables automatically? Equating the cell ranges is one way that i know of but it is extremely tedious because i have over 50 tables of such. Hard coding these equations are a trouble.This is a basic code I have done to copy paste a table .
Sub table()
ActiveSheet.ListObjects("Table1").Range.Copy
'This code will run only when the cursor is at activesheet
Sheets("Sheeet2").Range("A2").PasteSpecial xlPasteValues
End Sub
Here is an example of how to add Table Connections to a new Workbook and a way to Refresh the tables.
The code steps through each ListObject in ListObjects (Tables), .Add's the connection to the new Workbook and places the Table into the Worksheet.
It then creates a new Worksheet and process the next ListObject.
You can change the Workbook and Worksheet names + path to your needs.
*Do note that for unknown reasons to me the Table mixes the rownumbers up when placing them into the new Worksheet, it however doesn't mix the Columns.
AddTableConnectionsToNewWB code:
Sub AddTableConnectionsToNewWB()
Dim tbl As ListObject
Dim tblConn As ListObjects
Dim wb As Workbook
Application.ScreenUpdating = False
Set wb = Workbooks("TableConnections.xlsm")
Set tblConn = Workbooks("TestBook3.xlsm").Worksheets("Sheet2").ListObjects
For Each tbl In tblConn
wb.Connections.Add2 "WorksheetConnection_TestBook3.xlsm!" & tbl, _
"", "WORKSHEET;H:\Projects\TestBook3.xlsm", "TestBook3.xlsm!" & tbl, 7, True, _
False
If wb.Worksheets.Count = 1 Then
With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _
Connections("WorksheetConnection_TestBook3.xlsm!" & tbl), Destination:=Range( _
"$A$1")).TableObject
.RowNumbers = False
.PreserveFormatting = True
.RefreshStyle = 1
.AdjustColumnWidth = True
.ListObject.DisplayName = tbl.Name
.Refresh
End With
wb.Worksheets.Add after:=wb.Worksheets(Worksheets.Count)
Else
With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _
Connections("WorksheetConnection_TestBook3.xlsm!" & tbl), Destination:=Range( _
"$A$1")).TableObject
.RowNumbers = False
.PreserveFormatting = True
.RefreshStyle = 1
.AdjustColumnWidth = True
.ListObject.DisplayName = tbl.Name
.Refresh
End With
If tblConn.Item(tblConn.Count).Name <> tbl.Name Then
wb.Worksheets.Add after:=wb.Worksheets(Worksheets.Count)
End If
End If
Next
Application.ScreenUpdating = False
End Sub
Refresh code (this can also be done by simply clicking the refresh all button in Table Tools):
Sub RefreshTableConnections()
Dim wb As Workbook
Application.ScreenUpdating = False
Set wb = Workbooks("TableConnections.xlsm")
wb.RefreshAll
Application.ScreenUpdating = True
End Sub
I'm currently trying to delete a worksheet and auto create a new worksheet with the same name.
I'm using the below code. However, when i run the code the windows pop up appears asking me to confirm deletion, i want to prevent this and just delete and replace with a new sheet. I want to avoid Send-keys for this.
ThisWorkbook.Sheets("Process Map").delete
ThisWorkbook.Sheets.Add.Name = "Process Map"
Try setting the DisplayAlerts to False (then back to true if that is what you want as the default setting.
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkBook.Sheets("Process Map").Delete
On Error Goto 0
Application.DisplayAlerts = True
ThisWorkbook.Sheets.Add.Name = "Process Map"
Or without error handling:
Application.DisplayAlerts = False
ThisWorkBook.Sheets("Process Map").Delete
Application.DisplayAlerts = True
ThisWorkbook.Sheets.Add.Name = "Process Map"