I'm working on a project in Excel using VBA. I'm getting sheets from other workbooks, which takes a little time. For a userfriendly perspective, I'd like to show a picture saying "Loading" while the application gets the different sheets.
My problem is that the picture doesn't show before the Sub has finished. I've tried troubleshooting this myself.
I've tried running the code to insert the picture in another Sub being called. I've tried adding "DoEvents". I've tried adding an application wait. I've tried "ActiveWindow.SmallScroll" and "Application.Calculate" all without any luck.
I cannot see why the picture wouldn't show when the code is run.
If I add a break point in the code, the picture shows when I'd like it. I'm out of ideas and hope you can help me.
This is a snip of my code:
Sheet1.Activate
Application.Goto Reference:=Range("a1"), Scroll:=True
PicLoad = "PicLoad"
Sheet1.Pictures.Insert(Pictures & PicLoad & ".jpg").Name = PicLoad & "_picture"
Sheet1.Pictures(PicLoad & "_picture").Width = Application.Width
Sheet1.Pictures(PicLoad & "_picture").Left = 0
Sheet1.Pictures(PicLoad & "_picture").Top = 0
Sheet1.Shapes(PicLoad & "_picture").Line.Visible = msoTrue
Sheet1.Shapes(PicLoad & "_picture").Line.ForeColor.ObjectThemeColor = msoThemeColorText1
Sheet1.Shapes(PicLoad & "_picture").Line.Weight = 1
If ThisWorkbook.Path = requiredPath Then
Application.Run "Module4.HideCal"
For Each ws In ThisWorkbook.Worksheets 'Sletter alle worksheets undtagen nummer 1
If ws.Index <> 1 Then
ws.Delete
End If
Next
thisName = ThisWorkbook.Name
Workbooks.Open (requiredPath & "\" & fileComponents & "*.xl??"), ReadOnly:=True, CorruptLoad:=xlRepairFile 'f?r componenter ind
fileComponents = ActiveWorkbook.Name
total = Workbooks(thisName).Worksheets.Count
Workbooks(fileComponents).Worksheets(1).Copy _
after:=Workbooks(thisName).Worksheets(total)
Workbooks(fileComponents).Close
*Continues getting worksheets from different workbooks..
The Module4.HideCal contains:
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Everything works exactly as it should. The only problem is that the picture doesn't show until the sub has finished. I'd like to show it before the If statement.
Best regards
Check your Application.ScreenUpdating - if it is False, then you have told Excel not to show this. You will need to tell Excel to redraw/update the screen!
One method that sometimes forces the screen to redraw is
Application.WindowState= Application.WindowState
You may, just to be safe, also want to toggle the Application.ScreenUpdating around this:
Appliction.ScreenUpdating=True
Application.WindowState= Application.WindowState
Application.ScreenUpdating = False
Related
I have built an Add-In which is intended to be downloaded from the www. The Add-In will land up in the user computer's Downloads folder.
On being activated, the first phase of the Add-In's activty is to copy itself into the user's '/Microsoft/AddIns' folder using SaveAs. Then then "parent" Add-in closes itself and quits Excel. (On restarting Excel the "child" Add-In will be loaded and active.)
The code for this is
Sub CheckInstall()
'Several lines of code before this.
'They have been tested and seem to work well.
MyNewfileNm = TestBase & GCSAPPNAME
If IsInstalled(MyNewfileNm) Then
Application.DisplayAlerts = False
ThisWorkBook.SaveCopyAs MyNewfileNm
Application.DisplayAlerts = True
MsgBox "We're done, and Excel will close." & Chr(13) & _
"On reopening you will find 'ACBA Mapping' loaded and active in the ADD-INS tab."
Excel.Application.Quit
ActiveWorkbook.Close False
Else
ThisWorkBook.SaveCopyAs MyNewfileNm
If ActiveWorkbook Is Nothing Then
Workbooks.Add
Set oAddIn = Application.AddIns.Add(MyNewfileNm, False)
oAddIn.Installed = True
Else
Set oAddIn = Application.AddIns.Add(MyNewfileNm, False)
oAddIn.Installed = True
End If
MsgBox "We're done, and Excel will close." & Chr(13) & _
"On reopening you will find 'ACBA Mapping' loaded and active in the ADD-INS tab."
Excel.Application.Quit
ActiveWorkbook.Close False
End If
End Sub
This processes and copies itself as expected, but before the Application.Quit completes I get an Error Code 91. On clicking the error message, it simply resumes the instruction code.The result is precisely as expected.
However, I must either solve the problem generating the error message or suppress the error message. For the time being I cannot do either.
I'd be grateful for a solution.
This turned out to be a silly mistake on my part. The revised code below runs without an error. The only difference is the elimination of the instruction to close the ActiveWorkbook in the first portion if the primary IF statement. There was no open workbook available to be closed at that juncture.
Sub Check Install()
'Several lines of code before this.
'They have been tested and seem to work well.
MyNewfileNm = TestBase & GCSAPPNAME
If IsInstalled(MyNewfileNm) Then
Application.DisplayAlerts = False
ThisWorkBook.SaveCopyAs MyNewfileNm
Application.DisplayAlerts = True
MsgBox "We're done, and Excel will close." & Chr(13) & _
"On reopening you will find the " & NewMappingVersion & " version of 'ACBA Mapping' loaded."
Excel.Application.Quit
' In principle we haven't initiated a Workbook so there is no need to close it.
' ActiveWorkbook.Close False
Else
ThisWorkBook.SaveCopyAs MyNewfileNm
If ActiveWorkbook Is Nothing Then
Workbooks.Add
Set oAddIn = Application.AddIns.Add(MyNewfileNm, False)
oAddIn.Installed = True
Else
' This shouldn't be necessary, but leave it for the time being.
Set oAddIn = Application.AddIns.Add(MyNewfileNm, False)
oAddIn.Installed = True
End If
MsgBox "We're done, and Excel will close." & Chr(13) & _
"On reopening you will find 'ACBA Mapping' version " & NewMappingVersion & " loaded and active in the ADD-INS tab."
Excel.Application.Quit
ActiveWorkbook.Close False
End If
End Sub
I have the code below, which works perfectly when run from a command button on sheet 6 of "filename.xlsx". (name changed, as it's a work file) It opens a userform, where I enter the date in a textbox (dateFind), it then populates 100 labels on the userform, then from sheet 29, it gets the appropriate week number.
Once it has all the info on the userform, it then moves it into tester.xlsx. and then saves the file using variables from the userform to create the filename. A quick check of the figures from the open userform to tester is done, then click OK on the message box to close form.
(Sorry if that's long winded, I thought the above might help to explain what I'm doing) :)
What I need it to do though is run from a button on another user form. This requires referencing the full filepath of the filename.xlsx as when it's run at work eventually, both "filename.xlsx" and "tester.xlsx" will be in different folders.
I've tried set = workbooks.open and then the full file path for both sheet 29 and sheet 6, and get a run time error 424. Object required. in sheet 29. I assume that that'll be the case for sheet 6 as well, but it's there.
Private Sub cb1_Click()
Dim wkbk As Workbook
Dim SubDate As Range
Dim WkNo As Range
Dim txt As String
Dim Filename As Variant
With Application
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
End With
'Suggested Edited code start
Set sourceWb = Workbooks.Open ("F:\Users\e-lia\Desktop\filename.xlsx" )
Set WkNo = sourceWb.Sheets("Sheet29").Range("A:A").Find(what:=dateFind.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not WkNo Is Nothing Then
Me.WeekNo.Caption = WkNo.Offset(0, 1).Text
Else
MsgBox "Please check the date, and try again!"
End If
Set SubDate = sourceWb.Sheets("Sheet6").Range("A:A").Find(what:=dateFind.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not SubDate Is Nothing Then
'Suggested Edited code end
Me.MON.Caption = SubDate.Offset(0, 0).Text ‘another 100 similar lines
Else
MsgBox "Please check the date, and try again!"
End If
Set wkbk = Workbooks.Open("F:\Users\e-lia\Desktop\tester.xlsx")
wkbk.Sheets(3).Range("M21") = MON.Caption ‘another 100 similar lines
ActiveWorkbook.SaveAs Filename:="F:\Users\e-lia\Desktop\filename for - Wk No." & WeekNo.Caption & " - for the Week ending " & FRI.Caption & ".xlsx"
MsgBox "The filename for Wk No. " & WeekNo.Caption & " and week ending " & FRI.Caption & " has been created and saved to the Desktop Folder."
wkbk.Close False
With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
You may have been using the Codename instead of the actual Sheetname. The Sheetname is the name on the tab and the Codename is the name you will see in the project window not in parentheses. They can both be used, but there are different ways to use them. Looking at the example, you would refer to ThisWorkbook.Sheet1 using the codename and ThisWorkbook.Worksheets("Data") using the sheet name.
I am trying to write a code that I copied from somewhere else.
The code is not working and gives me an error.
Can someone please review and advise if there is a syntax error
Dim directory As String, filename As String, sheet As Worksheet, total As Integer
Dim WrdArray() As String
Application.DisplayAlerts = False
directory = "U:\GMR & PAYROLL REPORTS 2018-19\FEBRUARY 2019\COMPLETED\PAYSLIPS\"
filename = Dir(directory & "*.csv")
Do While filename <> " "
Workbooks.Open (directory & filename)
WrdArray() = Split(filename, ".")
For Each sheet In Workbooks(filename).Worksheets
Wookbooks(filename).ActiveSheet.Name = WrdArray(0)
total = Workbooks("PAYSLIPS CONSOL.xlsm").Worksheets.Count
Workbooks(filename).Worksheets(sheet.Name).Copy after:=Workbooks("PAYSLIPS CONSOL.xlxm").Worksheets(total)
GoTo exitFor:
Next sheet
exitFor:
Workbooks(filename).Close
filename = Dir()
Loop
Sheets("ALL HOMES").Select
lastsheets = Worksheets.Count
For i = 2 To lastsheets
mysheet = Sheets(i).Activate
mysheetrow = Cells(Rows.Count, 1).End(x1Up).Row
Range("A1;U" & mysheetrow).Select
Selection.Copy
Sheets("ALL HOMES").Select
lastrow = Cells(Rows.Count, 1).End(x1Up).Row
Range("A1").Select
Range("A" & lastrow).Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Next i
MsgBox "Your Report is Ready"
Application.DisplayAlerts = True
End Sub
In general, you can use VBA compiler to check whether your project can compile. To do this in the VBA Editor, click Debug -> Compile VBA Project. Everytime you click it, it will either run smoothly and say nothing, or show you the first compilation error in the project it runs into (so you can fix it and click Compile again).
I tried to compile the code you posted:
First, as suggested in the comment, you don't have the Sub line at the top. For example
Sub create_payroll()
, where create_payroll is your preferred name for this macro. Put this line right above all the code you posted in the question.
Second, there is a typo "Wookbooks" instead of Workbooks.
Error / Expected Output
When I run it from the VBA console, the code executes properly. If I step through the code manually in the debugger, it works.
The expected output is the ID of about 2000 data points. I am checking if a data matches the user input date. If that is the case, I print the ID of the event on the other sheet. Ideally, I will have a list of inputs that have numerical IDs.
When I run the code from the console or debugger, I will get a range of IDs like: 1,2,4,5,6,11,14,166... However, when I run this from the button I consistently get the first two data points, no matter which field (Date, Time, Size).
If I set a break point in the debugger then hit the button, the code is fine. All I have to do is hold run (F5). I think this tells me that the code compiles and works; meaning that the error is not a compile or logic error.
Goal
I would like the button to run the code normally.
More Info
I set a break point at every iteration of each loop. I held the step in key. The code ran flawlessly. This worked for both the console window, and the button.
Because of this, I thought I was experiencing an error due to race conditions. I went on to run the doEvents command. I was given the same results. The console and debugger ran the code properly, but the button did not.
The Code
Sub ThisBookSource()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Start = Now()
Dim masterRow As Integer
Dim myEvents
masterRow = 9
masterRow2 = 9
ActiveWorkbook.Worksheets("Graphs by Source").Activate
myCode = Range("D" & "2").Value
Range("C9:C2290").Clear
Range("T9:U2290").Clear
ActiveWorkbook.Worksheets("Data").Activate
For I = 3 To 2113
If Range("T" & I) = myCode Then
Worksheets("Data").Range("M" & I).Copy
Worksheets("Graphs by Source").Range("C" & masterRow).PasteSpecial xlPasteValues
masterRow = masterRow + 1
If I Mod 250 = 0 Then
DoEvents
End If
End If
Next I
ActiveWorkbook.Worksheets("Graphs by Source").Activate
Calculate
For I = 9 To 2290
If Range("I" & I).Value <> "NA" Then
Range("T" & masterRow2) = Range("G" & I).Value
Range("U" & masterRow2) = Range("I" & I).Value
masterRow2 = masterRow2 + 1
If I Mod 250 = 0 Then
DoEvents
End If
End If
Next I
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
MsgBox "Done. Started at " & Start & ", and ended at " & Now & "!"
End Sub
Note
I cannot post screen shots because the data is sensitive and confidential.
If you mean to work with ThisWorkbook, work with ThisWorkbook. Doing Range("foobar") [implicitly] works off ActiveSheet, which may or may not be a worksheet in ThisWorkbook - it's a worksheet in whatever workbook is currently active. It makes the whole difference. And causes bugs every day.
Rule of thumb, explicit anything is better than implicit whatever in VBA. The language is already doing way too much stuff behind your back, you need to take control.
Rubberduck (open-source VBE add-in project I manage) can help you find all instances of implicit ActiveSheet references... and many other potential issues.
I have a macro which loops through a list of Excel filepaths. The macro will read each path, open the workbook, copy/pull data out of each workbook and then pastevalues the data into a central workbook. There are about 2000 filepaths.
After a while (maybe after it has looped through the first 70 or so filepaths), Excel hangs. It shows the "Downloading" message box that you get when opening a file. If I click cancel on the msg box, the workbook opens and the macro continues as normal.
I would have to sit here for 1000s of filepaths. Why does Excel get stuck here? Is there a way around it?
This message box does not happen on every Workbooks.Open instance, just after every few.
Example of the code:
With ThisWorkbook.Sheets("Filepaths")
For i = firstrow To lastrow
SourceFile = .Cells(i, 1).Value
Workbooks.Open SourceFile, ReadOnly:=True
Set MyFile = Workbooks(Workbooks.Count)
' ..more code..........
' ..more code..........
' ..more code..........
MyFile.close
Next i
End With
Thanks for the comments. These are both good points (and are both solutions I believe I have tried in the past). But just to check, I modified my Workbooks.Open line:
Application.DisplayAlerts = False
Workbooks.Open SourceFile, ReadOnly:=True, UpdateLinks:=False
Application.DisplayAlerts = True
But the message box is still popping up.
What's weird is when I step thru line by line, after I step past the Application.DisplayAlerts = False line, when I hover over the "Application.DisplayAlerts" variable, it still says true?
Seems like you are trying to open a file from a shared drive and that is why it is showing you the "Downloading" message box. This happens sometimes.
Application.DisplayAlerts = False in such scenario will not help. Nor will ReadOnly:=True, UpdateLinks:=False help.
Try this code (Untested)
With ThisWorkbook.Sheets("Filepaths")
For i = firstrow To lastrow
SourceFile = .Cells(i, 1).Value
'~~> Check for network path and use sendkeys
'~~> to close the downloading window
If InStr(1, SourceFile, "\\") Then _
Application.SendKeys "~", True
Workbooks.Open SourceFile, ReadOnly:=True
Set MyFile = Workbooks(Workbooks.Count)
'..more code..........
'..more code..........
'..more code..........
MyFile.Close
Next i
End With