I have a macro in excel VBA which runs other macros. I am trying to implement Application.Screenupdating so that the user does not get to see what the macros do. However it seems to work for every macro, other than AccImport which is the main macro that I do not want my user to be aware of.
This macro does a spreadsheet transfer from excel to access, and I do not want my users to be aware of my access database. Within this macro it does a spreadsheet transfer by opening the access database, then closing it. Below is the main macro that I trigger, screenupdating=false seems to work for all the macros other than AccImport.
Any ideas? Thank you.
Sub ENTER1Dim2()
'
' ENTER1 Macro
'
'
If Worksheets("DIM21").Range("AR32") = 0 Then
MsgBox "Please enter DATA completely first"
End
Else
Application.ScreenUpdating = False
Application.Run "'NEW.xlsm'!TransferE1Dim2"
Application.ScreenUpdating = False
Application.Run "'NEW.xlsm'!PWDOFF"
Application.ScreenUpdating = False
Application.Run "'NEW.xlsm'!ProtectE1Dim2"
Application.ScreenUpdating = False
Application.Run "'NEW.xlsm'!UnprotectE2Dim2"
Application.ScreenUpdating = False
Application.Run "'NEW.xlsm'!ClearE2Dim2"
Sheets("Data1").Select
Application.ScreenUpdating = False
Application.Run "'NEW.xlsm'!AccImport"
Sheets("DIM21").Select
Range("G41").Select
Application.Run "'NEW.xlsm'!PWDON"
Call AUTOSAVE
End If
Application.ScreenUpdating = True
End Sub
Macro below is AccImport.
Sub AccImport()
'Application.OnTime Now + TimeValue("00:01"), "AccImport"
Dim Acc As New Access.Application
Acc.OpenCurrentDatabase "C:\Users\yilmadu001\Desktop\Database.accdb"
Acc.DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:="Table1", _
Filename:=Application.ActiveWorkbook.FullName, _
HasFieldNames:=True, _
Range:="Data1$A1:BL40000"
Acc.CloseCurrentDatabase
Acc.Quit
Set Acc = Nothing
End Sub
Related
So I have this problem which I can't wrap my head around.
I have a an excel report that executes an important macro on sheet_activate, and as we all know macros cancel CutCopyMode.
Therefore, if I want to copy & paste something from a different file into my report, it never works because as soon as I activate my report it runs the macro and cancels the CutCopyMode from the other file.
Things I have tried:
1) save cutcopymode value and re-activate it after the macro:
Dim tmpCT
tmpCT = Application.CutCopyMode
...
Application.CutCopyMode = tmpCT
the problem: it doesnt work.
2) save the data from the clipboard and re-insert it as plain text object after the macro is done running:
Dim DataClipBoard As String
Dim clipboardData As DataObject
Dim RangeCopied As Range
Set RangeCopied = Selection
DataClipBoard = ClipBoard_GetData
Application.CutCopyMode = False
...
Set clipboardData = New DataObject
With clipboardData
.SetText DataClipBoard
.PutInClipboard
End With
Set clipboardData = Nothing
The problem: it's plain text and doesn't retain formats/links/etc.
I'd appreciate any input you can give me on this issue.
The following macro will return the current range for Cut/Copy, which you can then store in a Range variable and re-Cut/Copy after your other workbook is open.
(Personally, I think that Application.CutCopyRange should be a built-in special variable to do this.)
Function CutCopyRange() As Range
Dim StoredMode As XlCutCopyMode
StoredMode = Application.CutCopyMode
If StoredMode < 1 Then Exit Function 'Null case
If StoredMode = xlCut Then
'Disappointing, since Clipboard lets you Paste a copy of a cut range...
MsgBox "Unfortunately, Worksheet.Paste(Link:=True) only works for Copy-mode.", vbCritical
Exit Sub
End If
Dim ScreenUpdating As Boolean, DisplayAlerts As Boolean, EnableEvents As Boolean
ScreenUpdating = Application.ScreenUpdating
DisplayAlerts = Application.DisplayAlerts
EnableEvents = Application.EnableEvents
Application.ScreenUpdating = False
Application.EnableEvents = False
'This makes us loose our Cut/Copy mode...
With Worksheets.Add
.Paste Link:=True
Set CutCopyRange = Range(Range(Replace(Selection.Cells(1, 1).Formula, "=", "")), _
Range(Replace(Selection.Cells(Selection.Rows.Count, Selection.Columns.Count).Formula, "=", "")))
Application.DisplayAlerts = False
.Delete
End With
'Restore Cut/Copy mode to what it was before the previous block
Select Case StoredMode
Case xlCut
CutCopyRange.Cut
Case xlCopy
CutCopyRange.Copy
End Select
Application.DisplayAlerts = DisplayAlerts
Application.ScreenUpdating = ScreenUpdating
Application.EnableEvents = EnableEvents
End Function
I have a VBA function that will crash excel when I run it ("Microsoft Excel has stopped working"), but works fine if I step through each line in the editor. I want to open another workbook with the function, change the slicers on a given sheet, find a value, and then close the new workbook without saving it. The function I have is as follows:
Function ValueLookup()
Dim Check As Boolean
Dim NewBook As Workbook
Check = IsWorkBookOpen("C:\Location\Filename")
If Check = False Then
Set NewBook = Workbooks.Open("C:\Location\Filename")
Else
Set NewBook = Workbooks("Filename")
End If
NewBook.Activate
Worksheets("Sheetname").Activate
ActiveSheet.PivotTables("pivottable1")ManualUpdate = True
With ActiveWorkbook.SlicerCaches("Slicer_SlicerName")
.ClearManualFilter
.VisibleSlicerItemsList = Array("[Tablename].[Columnname].&[MyValue]")
End With
ActiveSheet.PivotTables("pivottable1").ManualUpdate = False
ValueLookup = ActiveSheet.Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
searchorder:=xlByRows, _
searchdirection:=xlPrevious, _
MatchCase:=False)
If Check = False Then NewBook.Close savechanges:=False
End Function
(IsWorkBookOpen() is taken from Detect whether Excel workbook is already open, and doesn't seem to present any issues).
It seems that trying to close the new workbook is what's causing the issue, and if the workbook is open before I run the function there is no issue. The subroutine that calls the function will normally execute the line after the function right before excel crashes (opening a MsgBox for user input). I have tried adding Sleep 1000 after each line and adding DoEvents after the last line with no change in results. I've tried changing
NewBook.Close savechanges:= False
to
Application.Windows("NewBook").Close
without any difference. I've also tried replacing the end with
If Check = False Then
Cancel = True
Application.OnTime Now, "Close_Xls"
End If
End Function
Sub Close_Xls()
ThisWorkBook.Close savechanges:=False
End Sub
but this closes the wrong workbook (the original one I'd like the macro to be run from) after my subroutine has finished. However, it does seem to execute the code successfully before closing the wrong workbook, and does not cause excel to crash.
Any suggestions?
Edit:
It now appears to work without issues. I changed the following:
If Check = False Then NewBook.Close savechanges:=False
End Function
To
NewBook.Saved = True
If Check = False Then
Cancel = True
Application.OnTime Now, "Close_Xls"
End If
End Function
Sub Close_Xls()
Workbooks("Filename").Close savechanges:=False
End Sub
Thanks!
Changing the Close_Xls() sub to the following will target the correct sheet to close:
Sub Close_Xls()
Workbooks("Filename").Close savechanges:=False
End Sub
Another way to close the workbook without saving that might work is to use:
NewBook.Saved = True
before closing.
My macro for changing sheets doesn't work anymore after I created a few UserForms. Thought the problem was the UserForms were not unloading properly but that doesn't seem to be the case.
When I click the button (which resides in a custom pop up menu) to go to another sheet it works but the sheet acts frozen, I can't scroll or highlight for example.
But if i change sheets by clicking on the tabs then everything is fine. So it would appear that my code to active another sheet is faulty.
My excel workbook has some UserForms, Worksheet_Change and Worksheet_SelectionChange events if that matters.
Is there a better way of doing this. Something that will obviously work and note freeze my sheet after it is activated?
Sheet goto Code:
Sub goto630()
Application.ScreenUpdating = False
Dim sht2 As Worksheet
Set sht2 = ThisWorkbook.Worksheets(2)
Dim sht3 As Worksheet
Set sht3 = ThisWorkbook.Worksheets(3)
sht3.Activate
sht3.Protect _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
UserInterFaceOnly:=True, _
AllowFormattingCells:=True
sht2.Visible = True
sht3.Visible = True
On Error GoTo 0
ActiveWindow.Zoom = 90
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
Application.DisplayFormulaBar = True
sht3.DisplayPageBreaks = False
ThisWorkbook.Worksheets(1).Visible = False
ThisWorkbook.Worksheets(4).Visible = False
ThisWorkbook.Worksheets(5).Visible = False
ThisWorkbook.Worksheets(6).Visible = False
ThisWorkbook.Worksheets(7).Visible = False
ThisWorkbook.Worksheets(8).Visible = False
Set sht2 = Nothing
Set sht3 = Nothing
Application.ScreenUpdating = True
End Sub
UserForm Code:
Private Sub UserForm_Click()
Application.OnTime Now + TimeValue("00:00:01"), "Finish"
Unload Me
Call Module2.ScreenRefresh
Exit Sub
End Sub
ScreenRefresh Module is just Application.ScreenUpdating = True read somewhere about this same problem that if the ScreenUpdating is in another module then when called it will fix the freeze issue.
Finish Module is activating the sheet again after the UserForm has been closed (also said to help the freeze issue).
It seems that Excel is waiting for me to click a cell before allowing me to scroll. How can I get around this?
Thanks for any help :)
Big thanks to A.S.H for helping me with out with this code earlier.
Right now, I'm attempting to show a splash sheet that tells users to enable macros in order to access the workbook. The plan is to save the file with the splash sheet visible and other sheets veryhidden during the BeforeClose event. During the Open event, the splash sheet will be made veryhidden and the other sheets will be made visible.
Hence, the user will only see the splash sheet when he/she opens the file with macros disabled. However with the below code, it doesn't seem as though the routine that makes the splash sheet visible and the rest veryhidden is running. Where have I gone wrong?
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim rs As Object, ws As Object
Dim Ans As Integer
Dim target As Range, r As Range
Set rs = Sheets("Report")
If Me.Saved = False Then
Do
Ans = MsgBox("Do you want to save the changes you made to '" & _
Me.Name & "'?", vbQuestion + vbYesNoCancel)
Select Case Ans
Case vbYes
With rs
Set target = .Range("B5:R" & .Cells(.Rows.Count, 2).End(xlUp).Row)
End With
target.Value = Application.Trim(target.Value)
For Each r In target.Rows
If Not IsEmpty(r.Cells(1)) And Application.CountIf(r, "") > 0 Then
Cancel = True
r.Parent.Activate: r.Activate
MsgBox ("Please confirm all required fields have been completed")
Exit Sub
End If
Next
Application.ScreenUpdating = False
Sheets("Reminder").Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Reminder" Then
ws.Visible = xlSheetVeryHidden
End If
Next ws
ActiveWorkbook.Save
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Reminder" Then
ws.Visible = xlSheetVisible
End If
Next ws
Sheets("Reminder").Visible = xlSheetVeryHidden
ThisWorkbook.Saved = True
Application.ScreenUpdating = True
Case vbNo
Me.Saved = True
Case vbCancel
Cancel = True
Exit Sub
End Select
Loop Until ThisWorkbook.Saved = True
End If
End Sub
If you are experiencing screen trouble, it is likely due to some erroneous manipulation of Application.ScreenUpdating here and in other macros. In this one, the error is that you first set it to False and then Exit Sub without restoring it to True.
Moreover, since your routine only does calculation (checking) and does not change cell values, there's no point in disabling Application.ScreenUpdating.
On a side note, I think your routine that checks for empty cells can be much simplified.
Function dataIsValid() As Boolean
Dim target As Range, r As Range
With ActiveSheet ' <-- May be better change to some explicit sheet name
Set target = .Range("B5:R" & .Cells(.Rows.Count, 2).End(xlUp).Row)
End With
target.value = Application.Trim(target.value) ' <-- trim the whole range
For Each r In target.Rows
If Not IsEmpty(r.Cells(1)) And Application.CountIf(r, "") Then
r.Parent.Activate: r.Activate ' <-- Show erroneous row
MsgBox ("Please confirm all required fields have been completed")
Exit Function
End If
Next
dataIsValid = True
End Function
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = Not dataIsValid
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = Not dataIsValid
End Sub
I have a Excel Program that need to create another excel with password protected. I can create another excel but i don't know how to protect it with password. Below are the code for the creating another Excel File.
Option Explicit
Sub Macro1()
Dim Wk As Workbook
Set Wk = Workbooks.Add
Application.DisplayAlerts = False
Wk.SaveAs Filename:=”B:\Test1.xlsx”
Application.DisplayAlerts = True
End Sub
Hope you guys can help for this part.
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveWorkbook.SaveAs FileFormat:=xlNormal, Password:="pass", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Here is the documentation: Workbook.SaveAs Method (Excel)