I have a large workbook from which I am trying to build reports, including multiple graphs. The workbook has to be in Manual Calculation mode to work. I have compartmentalized the calculations into different sheets, and written vba scripts to run calculations on different combinations of sheets. The problem I am running in to is that after I run these scripts, the graphs that I have will not update. The data does update, and if I manually go in to the graph and "select data" and re-select the same data then they will update. Is there a way I can automate this at the end of my script? I have tried different suggestions on different forums, but nothing seems to work. Here is the code I am currently working with, but it will not update the graphs:
Sub Calculate1()
Sheets("Sheet 1").Calculate 'Sheet with calculations
Sheets("Sheet 2").Calculate 'Sheet referencing final numbers from sheet 1, and displaying graphs
Dim co As ChartObject
For Each co In Sheets("Sheet 2").ChartObjects
co.Chart.Refresh
DoEvents
Next co
End Sub
Thanks for taking the time to look! I am running Excel for Mac 2016. One suggestion that has been made on other forums is to momentarily set the calculation mode to automatic, but this is not an option for me, as that will crash the program.
This snippet should work:
' Force the charts to update
Set sht = ActiveSheet
For Each co In sht.ChartObjects
co.Activate
For Each sc In ActiveChart.SeriesCollection
sc.Select
temp = sc.Formula
sc.Formula = "=SERIES(,,1,1)"
sc.Formula = temp
Next sc
Next co
Credits: https://stackoverflow.com/a/11581258/2707864
This might also work (YMMV):
Worksheets("Sheet 2").Cells.WrapText=False
' Run your calculations
Worksheets("Sheet 2").Cells.WrapText=True
Credits: https://stackoverflow.com/a/7211065/2707864
See also
Refresh all charts without blinking (and this comment).
Excel chart won't update
You should be able to add co.calculate after your loop. You might also just be able to change Application.Calculation = xlAutomatic before your loop, and then change back to Application.Calculation = xlManual after the loop.
Related
I have a Macro Enabled template used for generating end user proposals/estimates. This template references data sets on a shared drive to automatically generate item cost based on various factors.
Two issues has suddenly developed on the first and main tab that I presume are related.
My macros now spontaneously take 20 times as long to execute. There are few macros of principle concern. One that adds a single row each to the bottom of 3 tables and the other adds 10 rows to the bottom of each table and one that removes a row. These use to zip and not flow like molasses.
The other issue is I can no longer scroll up and down with my mouse wheel. The horizontal scroll wheel works just not up and down. This only effects the first tab. I have Google-fu'd and attempted most obvious solutions to no effect.
Both these issues manifested together. They only effect work books from a the newest version other the template. If I open an older template it works fine until I save. Then the slows down too.
Does not seem like this is an issue wit the macros themselves. Other macros on other tabs work as anticipated. Regardless below are the macros in question. Again, the macros operate without error. They just all of a sudden take much longer.
I am using Microsoft® Excel® for Microsoft 365 MSO (Version 2206 Build 16.0.15330.20260) 64-bit
Sub ADD1ROW()
Sheets("Office").ListObjects("Table1").ListRows.Add AlwaysInsert:=True
Sheets("Builder").ListObjects("Table2").ListRows.Add AlwaysInsert:=True
Sheets("Cost Analysis").ListObjects("Table3").ListRows.Add AlwaysInsert:=True
End Sub
Sub ADD10ROWS()
Dim i As Byte
For i = 1 To 10
Sheets("Office").ListObjects("Table1").ListRows.Add AlwaysInsert:=True
Sheets("Builder").ListObjects("Table2").ListRows.Add AlwaysInsert:=True
Sheets("Cost Analysis").ListObjects("Table3").ListRows.Add AlwaysInsert:=True
Next i
End Sub
Sub REMOVE1ROW()
Dim ans As Long
With Sheets("Office").ListObjects("Table1").Range
ans = .Rows.Count
.Rows(ans).Delete
End With
With Sheets("Builder").ListObjects("Table2").Range
ans = .Rows.Count
.Rows(ans).Delete
End With
With Sheets("Cost Analysis").ListObjects("Table3").Range
ans = .Rows.Count
.Rows(ans).Delete
End With
End Sub
(07/08/21 - I edited my text to update and sharpen the problem).
I have made an Excel VBA program that provides the conditional formatting of a large number of cells (which are formatted using the formulas option which refer to cell values in the target spreadsheet). The script and spreadsheet works fine, but I have a problem as immediately after I have run my script (or to be precise a particular input box script has been run) then ghost images appears. (I can easily replicate the issue including on different Windows machines.) The ghost images no longer happen if the user saves the sheet and then re-opens it. However, to me this is not a good solution and makes the program look poor in quality and trustworthiness!
I have a "first" routine that when run (via a button press) uses an Application.Inputbox - this allows the user to select a range of cells. These selection of cells are located in the target worksheet which is a different workbook to where the code is run from. Also, the selection of cells are located in a sheet that is not the front sheet of the workbook concerned.
I then have another second button which when pressed uses collected data and conditionally formats the target spreadsheet. However, after doing this button press I get ghost images appearing (which shows cells from selection made earlier from the first button press).
The screenshot below illustrates the occurrence - you can see that there is a table being shown from the second sheet on the top left-hand side of the sheet (despite not fitting the cells of screen 1!). I hope that makes sense.
Someone kindly below said that I needed to use:
Application.ScreenUpdating=False
and then return it to true at the end.
However, I still have the same ghost images occur and I note these happen after the script has been run.
From researching the topic, I found that this is a common issue from using the property Application.InputBox. If I run my second program without using the first one immediately before it (which has the Application.InputBox) then no ghost images appear. Therefore, I think it is pretty safe to assume the problem has come from this Application.InputBox! However, I have not been able to find a solution! I list below the code used for the first Application.InputBoxs routine.
Sub UserSelectsCells()
Dim rng As Range
Dim wks As Worksheet
Dim wkb As Workbook
If Range("C9") <> False Then
Workbooks.Open Filename:=Range("C9")
End If
On Error Resume Next
Set rng = Application.InputBox( _
Title:="Select Test Cells", _
Prompt:="Please Find The Cells In Your Workbook That Test Whether The User Has Answered The Questions Correctly" & vbCrLf & "Remember this may be in a different sheet in your workbook" & vbCrLf & "These cells must be in a single column", _
Type:=8)
On Error GoTo 0
'Test to ensure User Did not cancel
If rng Is Nothing Then
Workbooks("Version060821.xlsm").Activate
Exit Sub
End If
Workbooks("Version060821.xlsm").Activate
Range("C32").Value = rng.Parent.Parent.Name
Range("C33").Value = rng.Parent.Name
Range("C34").Value = rng.Address
Range("D35").HorizontalAlignment = xlLeft
Range("D35").Value = rng.Count
End sub
Can anyone please find a solution? As an idea, is it possible to somehow clean the memory before my second program is run?
I note that if there is a ghost images problem and I delete all of the conditional formating then the ghost images still appear. I think this is significant because the conditional formatting is linked to the ghost image cells that appear. So, to me this suggests there is some kind of microsoft bug?
I'm not exactly sure why these ghost screens pop up sometimes but I've found that preventing the screen from flashing during your code normally fixes the issue. You can do this by setting Application.ScreenUpdating to False and the beginning of your code. Just be sure to set it back to True at the end! Something like this:
Application.ScreenUpdating = False
[Your code]
Application.ScreenUpdating = True
edit:
After further research, it would appear this is an issue that has been already identified. The workaround below originally comes from here.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wSheet As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
For Each wSheet In Worksheets
wSheet.Select
Range("A1").Select
Next
Application.ScreenUpdating = True
End Sub
This is definitely a dirty fix but if it works it works. An alternative solution was to scroll up and down using:
Private Sub worksheet_change(ByVal target As Range)
Application.ScreenUpdating = False
ActiveWindow.SmallScroll Down:=-100
ActiveWindow.SmallScroll Up:=100
Application.ScreenUpdating = True
End Sub
Please let me know what works best!
Not enough rep for a comment!
Alec, Workbook_BeforeClose is a workbook event, you don't call it like procedures.
Workbook_BeforeClose Event
From that documentation, "False when the event occurs. If the event procedure sets this argument to True, the close operation stops and the workbook is left open.". So if you add Cancel=True inside it, say, after an if statement check, you can stop the close operation.
Edit: In order to answer the question in comments.
The event is fired when you close the workbook, either from the X in the corner or from the menu, or if you have something like ActiveWorkbook.Close in your code.
You don't have to have a Cancel=True/False inside BeforeClose event's code, depends on if you want to control a premature closure of the workbook. It is required, say, if you were writing the event yourself instead of selecting it in VBA editor. Editor already inserts that parameter.
I'm actually trying to make a userform that controls every checkbox in the Workbook Sheets (it's mostly graphs that shows the data from a specific period for the Company), since every graph has the same checkboxes (ActiveX ones) with the same names on them I though about making a Userform that is always active and in this way the client can just select which ones he will use and it would just loop through the other sheets without a problem.
But here is the problem first of all my code:
Dim ws As Worksheet
If Me.CheckBox1.Value = True Then
For Each ws In ThisWorkbook.Worksheets
ws.OLEObjects("chkAno1").Object.Value = 1
Next ws
ElseIf Me.CheckBox1.Value = False Then
For Each ws In ThisWorkbook.Worksheets
ws.OLEObjects("chkAno1").Object.Value = 0
Next ws
End If
I did it with only one checkbox to test it out (There is a "chkAno1" in every sheet that I want to affect) but everytime I run the code and click the checkbox I get " Error 1004: The Method "OLEObjects" from object "_Worksheet" Failed", and what's weird is that If I change "ws" with "ActiveSheet" the code works fine, but only updates the currently open sheet.
So I'm at a loss right now.
thanks for your help. I found out the problem, there was some sheets without any Checkboxes on them, so the Code kept giving me the error.
The solution I found for it was to put On Error Resume Next at the beggining and it worked like a charm! (I actually needed to put it on the graphs as well)
But in the end I ended up reworking the code to affect directly the Graph using ws.ChartObjects("grafico").Chart.FullSeriesCollection(1).IsFiltered = True instead of ws.OLEObjects("chkAno1").Object.Value = 1 Because at the end the process of updating every checkbox and after that all the charts would be actually really slow on some older computers and updating directly the Graph showed a great increase in speed.
Thanks to everyone that Commented and I hope the solution I found can help someone else!
I Need to Copy an picture/image of a chart which is in another workbook (WbO), and paste the picture in a worksheet in this workbook (TWb), using Excel vba.
I figured out a simple code to do this.
The good thing is that the code works. Stepping line by line throught the code everything completes perfectly.
However, if I run the code (no Stepping) it also runs until the end without any error and completes the job. BUT, by the end Excel Crashes without any error message, restarts and reopens the workbook. (all work lost).
The weirdiest thing is that it crashes 3 to 5 seconds after ending the run. 3 to 5 seconds is an enormous lenght of time for computing. What is it doing during this time??
For testing, I added a 'Msgbox "Completed", vbokonly' as last code line. This made vba stop and show the message, and no crash while the message is on screen. Clicking ok, the macro runs to the end and then, after some seconds ... Crash.
Searched for similar problems in the web and found some old posts refering errors related to copy/paste, but no complete crash like this.
Tried this same file/code in different PCs, both with up-to-date office 365 but different update channels (not same build). The result was exactly the same.
Tried changing the .CopyPicture statement to a normal Copy, and then using PasteSpecial as Picture. Same Result.
Even tried moving the copy/Paste instructions to different subs (suggestion from a 2018 post), and inserting DoEvents in between .. without any luck.
Does someone have a clue why this is hapenning?
How to overcome this issue?
Help welcomed
Sample code below:
Application.EnableEvents= False
Set WbO = /Workbooks.Open("WbOFileName",0)
Set ChrtObj= Worksheets("MyCharts").ChartObjects(1) 'Set handle to the Chart obj
TWb.Activate ' Activate destination Workbook = The Wb which contains the macro
ChrtObj.CopyPicture
RangeToPasteOn(1,1).Select ' Select Top-Left cell to paste the Chart on
ActiveSheet.paste ' Paste the Chart
' ... here Code to ajust Size and position to fit destination range
Application.CutCopyMode = False
Set ChartObj = Nothing 'Release handle
WbO.Close
Set WbO = Nothing
Application.EnableEvents= True
I have two different workbooks with approx 15 columns and 50k rows in one workbook and 10columns and 1000 rows in another workbook and only 2 columns(partnumber, changelevel)are in common. So I want to pull two reports from these two workbooks.
Records with common partnumber & changelevel in to a different workbook as one report.
I want to delete the common part number & changelevel records from first workbook and copy all the remaining records into a different workbook as another report.
Angiee . . .
You have a couple of questions that will need to answered before anyone can help you with this.
Is this a one time deal where you are trying to clean up data and come up with a new starting point and you won't need to run this process over and over again?
Can we assume that the data rows are not in the same Worksheet row in both Workbooks?
If the answer to both questions is YES then I would have to say that Excel is decidedly NOT the Office Application that you should be using. I would suggest that you import both Workbooks into an Access Database as separate tables. That way you can use SQL to perform the matches and lookups with little or no code needed. You can easily export the query results back to an Excel Workbook once you have the results you want. You could probably have your answer in an hour. If you go with this option you can also link the Worksheets into the Access DB and avoid importing them. It won't be as fast but it will work.
Otherwise, if you are stuck with Excel then you either have a significant amount of code to write that pretty much consists of looping through all of the records in one Workbook, looking up the values in the other Workbook then generating the output in still more Workbooks. . . or . . . you could try copying the Worksheet with the 1000 records into the other Workbook and then using the Worksheet Functions VLOOKUP and/or HLOOKUP to create a lot of formulas. (I can't in good conscience endorse this second approach but if you are not very experienced at VBA then it may be the better approach for you).
Either way you go with the Excel solution there'll be a lot of work invloved.
If you have any specific coding issues then you are in the right spot. But you will need to pick an approach first.
Good luck!
Doug
The question is an easy one to answer, the problem comes into two fold.
How fast is your computer?
How often do you need to run this code?
The reason I ask these questions are because to run any code on 50,000 lines no matter how small the code to actually make this work is... you need to have a computer that is rather robust, otherwise this code is going to stall your computer, or at least excel for a good minute to three minutes+ depending on how fast and how much memory you actually have.
Without seeing your workbook you need some very simple formulas, but what you are going to have to do is add another line into the workbook. In Column P, you need a verification formula. This formula is simple, but it will depend on how many points of reference you require.
=COUNTIFS('Sheet2'!$A:$A,$A3,'Sheet2'!$E:$E,$E3)
From there you can see what are duplicates or not. You can then have in column Q a formula like this:
=IF($P3,"SAME","")
And it will tell you if the data is the same or not. Basically it says if there is anything but 0 in the cell P3 it will say there is something the same, otherwise it's not.
From there you need a code sort of like this:
Sub Update_TNOOR()
Dim wsS1 As Worksheet
Dim wsS2 As Worksheet
Dim lastrow As Long, fstcell As Long
Set wsS1 = Sheets("Sheet1")
Set wsS2 = Sheets("Sheet2")
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
With wsS1
wsS1.Columns("P:Q").ClearContents
ThisWorkbook.Sheets("Sheet1").Cells(1, 16).Value = “=COUNTIFS('Sheet2'!$A:$A,$A3,'Sheet2'!$E:$E,$E3)"
ThisWorkbook.Sheets("Sheet1").Cells(1, 17).Value = “=IF($P3,"Same",””””)"
wsS2.Columns("P:Q").ClearContents
ThisWorkbook.Sheets("Sheet2").Cells(1, 16).Value = “=COUNTIFS('Sheet1'!$A:$A,$A3,'Sheet1'!$E:$E,$E3)"
ThisWorkbook.Sheets("Sheet2").Cells(1, 17).Value = “=IF($P3,"Same",”Different”)"
End With
With Intersect(wsS1, wsS1.Columns("Q"))
.AutoFilter 1, "<>Same"
With Intersect(.Offset(2).EntireRow, .Parent.Range("B:Q"))
.EntireRow.Delete
End With
.AutoFilter
End With
'Blow away rows that are useless
lastrow = wsS2.Range("A2").End(xlDown).Row
wsS2.Range("P1:Q1").Copy wsS2.Range("P2:Q" & lastrow)
With Intersect(wsS2.UsedRange, wsS2.Columns("Q"))
wsS2.Range("P:Q").Calculate
.AutoFilter 1, "<>Different"
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
With wsS2
lastrow = wsS2.Range("A1").End(xlDown).Row
Intersect(.UsedRange, .Range("A1:N" & lastrow)).Copy wsS1.Cells(Rows.Count, "B").End(xlUp).Offset(1)
End With
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
End Sub
this should get you on your way... if I read what you are attempting to do correctly.
As people have said though, what you want done can be done in excel, should it, I don't know... people here seem to think not, but if you need to use excel, this should get you on your way.
Again, I don't know what your workbook looks like, so I hope this helps. This compares data and merges it into the first sheet. IT won't do everything you want to do... but this should get you on your way.