I'm trying to animate a parametric curve in Excel by generating its ranges in an iterative loop. I'm using the code:
Public Sub playswirl()
Range([a8], [a8].End(xlDown)).Clear
Set cell = Range("a8")
Do While cell.Offset(0, 1) <> ""
cell.Offset(-1, 0).Copy cell
ActiveSheet.ChartObjects(2).Chart.Refresh
DoEvents
Sleep (50)
Set cell = cell.Offset(1, 0)
Loop
End Sub
The chart is cleared in the first instruction, then rebuilt one item at a time in the loop. While the code is running, I see the values in the spreadsheet changing one at a time, but the chart never updates (I see the full curve, i.e. the state before the first line of code is executed). When I ctrl-break and put the code in debug state, the chart updates to the point where the code was interrupted.
I thought that the chart.refresh would have done the trick - and added the doevents in for good measure when that didn't work - but no luck. Changing the sleep call to the Excel-native Application.Wait call doesn't help either (and is too slow in any case).
Any ideas?
I think it may not be a problem with the chart; it may be a problem with the updating system. If Application.ScreenUpdating = True (which it is by default), then here are some things you can try:
Try adding the "DoEvents" to your loop like explained here.
Try adding "Calculate" to the function. For example, write the code ActiveSheet.Calculate.
Let me know how those go.
Related
On occasion you will want to copy a chart in Excel and paste it into a PowerPoint presentation using VBA. This comes in handy when you want to automate a report.
Problem: assuming you are not converting the graph to an image, and depending on the size and complexity of the graph you are trying to paste, the graph does not have time to paste before VBA attempts to continue with the procedure. This is annoying when you want to manipulate the graph after it has been pasted (e.g. positioning it on the slide). What effectively happens is you end up trying to move a chart on the slide... that does not yet 'exist' as a PowerPoint shape.
This issue is annoying and in my humble opinion actually constitutes a bug. I have not yet seen a robust solution to the problem on SO, with the potential exception of this answer from John Peltier. His answer is most likely correct (and has been designated as such on the thread) but unfortunately I could not get this to work in my implementation.
The issue I lay out below.
Code (simplified for ease of reference):
Public Sub X2P()
'Copy chart and paste
ActiveChart.ChartArea.Copy
Set mySlide = myPresentation.Slides(2)
PasteChartIntoSlide mySlide
End Sub
Function PasteChartIntoSlide(theSlide As Object) As Object
CreateObject("PowerPoint.Application").CommandBars.ExecuteMso ("PasteSourceFormatting")
End Function
I see others have tried to break up the script and to copy, paste and position charts using separate functions. This is cleaner, but it has not worked for me.
The solution I have found is to count the number of shapes on the slide before the code pastes the chart, num_obj, and to set variable num_obj_final as num_obj + 1 (i.e. total number of shapes once the chart has been pasted). I then create a loop after the paste event, where I recalculate num_obj with every iteration. Only when num_obj is equal to num_obj_final does the procedure exit the loop. And then the script can resume as expected, as you can be sure that the shape now 'exists' on the slide.
Final code for PasteChartIntoSlide() function:
Function PasteChartIntoSlide(theSlide As Object) As Object
theSlide.Select
num_obj = 0
num_obj_final = theSlide.Shapes.Count + 1
CreateObject("PowerPoint.Application").CommandBars.ExecuteMso ("PasteSourceFormatting")
DoEvents
Do Until num_obj = num_obj_final
num_obj = theSlide.Shapes.Count
'Debug.Print num_obj
Loop
End Function
I set out to write a simple function to determine the length of a string in points. Having googled around I decided to avoid the font metrics problem by having excel do the work for me.
Here is the code.
Option Explicit
Function txtWidthPts(MyText As String) As Integer
'A cell on a working worksheet has been named "WidthTest" for easy reference & to ensure data is not overwritten.
'set WidthTest word wrapping off so that strings placed in there aren't wrapped
Application.ScreenUpdating = False
With [WidthTest]
.WrapText = False
.Value = MyText
'autofit WidthTest
.Columns.AutoFit
'get the width of the column
txtWidthPts = .Width
.ClearContents
End With
End Function
I tested the function by placing it in a cell on a working worksheet thus:
=txtWidthPts("Test123")
When I have this working I will be using it in code not as a worksheet function.
My problem is that the function does not throw an error and stops execution on the line:
.Value = MyText
I have placed the code and name into an empty workbook to ensure no interaction with other workbook contents / code.
I have searched extensively and tried various suggestions (DoEvents, Application.Update = False, etc, etc.) to no result.
I have cleared all breakpoints, closed and opened the workbook & restarted. I have tested with options set to Break on All Errors.
No result.
I suspect I am missing something obvious but it has me beat at the moment.
Any and all suggestions will be most welcome.
So, #YowE3K was right on the money. After fixing the error in the original code (Corrected code above) this runs fine from vba. I knew I was missing something obvious.
Curiosity sub-question: the function works as desired and indeed, as #YowE3K observed, it does not modify the Excel environment. However the result returned is dependent on it appearing to have modified the Excel environment. Seriously WTF. Just wanting to understand.
Thanks again YoWE3K.
I am quite new to VBA. I have written a macro which creates about 10 pivot charts and some normal charts after filtering and cutting some data from a database spreadsheet. I now want to write a sub which goes through applying the same formatting to each one. The sub is as follows:
Sub FormatChart(Cht As ChartObject, title As String)
Cht.Activate
MsgBox ActiveChart.SeriesCollection.Count
With ActiveChart
.HasTitle = True
.ChartTitle.Text = title
.Axes(xlValue).HasMajorGridlines = False
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 182, 0)
End With
End Sub
I originally didn't include all the activates and selects, but couldn't get the macro to work without them and don't see it as the end of the world - the datasets are never going to be massive so speed isn't so much of a concern, and I disable screenupdating so that users can't click on cells/other objects and disrupt the macro as it runs.
Here's my problem. If I take out the second With loop, everything proceeds perfectly and the gridlines are removed and the title is added. However, whenever I try to edit the colours of columns with the above I get Run time error '1004': Invalid parameter. I've also tried keeping the content of the second with loop inside the first but then moved it out to try using selection to see if it made a difference.
I've fiddled around quite a bit and recorded various macros changing the colour of the chart in question, but I think the problem might be to do with referencing SeriesCollection as when I try to debug with
MsgBox ActiveChart.SeriesCollection.Count
I get "0".
Please let me know if I'm missing the point - as I said I am new to VBA and am trying to learn as much as possible :)
EDIT: The solution was that I was passing each chart to the above sub after I had created the chart, but before I had set a data source for the chart. Doh!
This obviously meant that there were no seriesCollections for that chart, hence the error I was getting.
I marked Joehannah as answering the question (even though it isn't technically the solution) because it made me check my code and notice that the above could be causing the problem - if I shouldn't do that someone please tell me and I'll try to fix it!
You are better off using Set cht = (create chart object) for each chart and then Immediately calling the format method passing in cht.
I have been told to post my own answer since I figured out the issue.
I was passing each chart to this function just after creating it, as follows:
Set ptr1 = Sheets("withinBRSPivots").PivotTables("UniqueClicks").TableRange1
Set cht1 = Sheets("BRS Overview").ChartObjects.Add(Left:=950, Top:=500, _
Width:=400, Height:=300)
cht1.Name = "UCChart"
Charter.FormatChart cht1, "Average Number of Unqique Clicks"
I then set the source data for the chart after doing the above. This meant that when the chart was passed to my chartformat sub, it had no source data. This is what resulted in being able to edit the title and gridlines, but not the seriesCollection. The fix was to just move the FormatChart sub line to after I had set the source data.
Many thanks to everyone who posted answers!
I have a subroutine that generates a report of performance of different portfolios within 5 families. The thing is that the portfolios in question are never the same and the amount in each family neither. So, I copy paste a template (that is formated and...) and add the formated row (containing the formula and...) in the right family for each portfolio in the report. Everything works just fine, the code is not optimal and perfect of course, but it works fine for what we need. The problem is not the code itself, it is that when I execute the code the first time, it goes really fast (like 1 second)... but from the second time, the code slows down dramatically (almost 30 second for a basic task identical to the first one). I tried all the manual calculation, not refreshing the screen and ... but it is really not where the problem comes from. It looks like a memory leak to me, but I cannot find where is the problem! Why would the code runs very fast but sooooo much slower right after... Whatever the length of the report and the content of the file, I would need to close excel and reopen it for each report.
**Not sure if I am clear, but it is not because the code makes the excel file larger or something, because after the first (fast) execution, if I save the workbook, close and reopen it, the (new) first execution will again be very fast, but if I would have done the same excat thing without closing and reopening it would have been very slow...^!^!
Dim Family As String
Dim FamilyN As String
Dim FamilyP As String
Dim NumberOfFamily As Integer
Dim i As Integer
Dim zone As Integer
Sheets("RapportTemplate").Cells.Copy Destination:=Sheets("Rapport").Cells
Sheets("Rapport").Activate
i = 3
NumberOfFamily = 0
FamilyP = Sheets("RawDataMV").Cells(i, 4)
While (Sheets("RawDataMV").Cells(i, 3) <> "") And (i < 100)
Family = Sheets("RawDataMV").Cells(i, 4)
FamilyN = Sheets("RawDataMV").Cells(i + 1, 4)
If (Sheets("RawDataMV").Cells(i, 3) <> "TOTAL") And _
(Sheets("RawDataMV").Cells(i, 2) <> "Total") Then
If (Family <> FamilyP) Then
NumberOfFamily = NumberOfFamily + 1
End If
With Sheets("Rapport")
.Rows(i + 8 + (NumberOfFamily * 3)).EntireRow.Insert
.Rows(1).Copy Destination:=Sheets("Rapport").Rows(i + 8 + (NumberOfFamily * 3))
.Cells(i + 8 + (NumberOfFamily * 3), 6).Value = Sheets("RawDataMV").Cells(i, 2).Value
.Cells(i + 8 + (NumberOfFamily * 3), 7).Value = Sheets("RawDataMV").Cells(i, 3).Value
End With
End If
i = i + 1
FamilyP = Family
Wend
For i = 2 To 10
If Sheets("Controle").Cells(16, i).Value = "" Then
Sheets("Rapport").Cells(1, i + 11).EntireColumn.Hidden = True
Else
Sheets("Rapport").Cells(1, i + 11).EntireColumn.Hidden = False
End If
Next i
Sheets("Rapport").Cells(1, 1).EntireRow.Hidden = True
'Define printing area
zone = Sheets("Rapport").Cells(4, 3).End(xlDown).Row
Sheets("Rapport").PageSetup.PrintArea = "$D$4:$Y$" & zone
Sheets("Rapport").Calculate
Sheets("RANK").Calculate
Sheets("SommaireGroupeMV").Calculate
Sheets("SommaireGroupeAlpha").Calculate
Application.CutCopyMode = False
End Sub
I do not have laptop with me at the moment but you may try several things:
use option explicit to make sure you declare all variables before using them;
from what I remember native vba type for numbers is not integer but long, and integers are converted to long, to save the computation time use long instead of integers;
your Family variables are defined as strings but you store in them whole cells and not their values i.e. =cells() instead of =cells().value;
a rule of a thumb is to use cells(rows.count, 4).end(xlup).row
instead of cells(3, 4).end(xldown).row.;
conditional formatting may slow down things a lot;
use for each loop on a range if possible instead of while, or even copy range to variant array and iterate over that (that is the fastest solution);
use early binding rahter of late binding, i.e., define objects in a proper type as soon a possible;
do not show printing area (page breaks etc.);
try to do some pofiling and look for the bottlenecks - see finding excel vba bottlenecks;
paste only values if you do not need formats;
clear clipboard after each copy/paste;
set objects to Nothing after finishing using them;
use Value2 instead of Value - that will ignore formatting and take only numeric value instead of formatted value;
use sheet objects and refer to them, for example
Dim sh_raw As Sheet, sh_rap As Sheet
set sh_raw = Sheets("RawDataMV")
set sh_rap = Sheets("Rapport")
and then use sh_raw instead of Sheets("RawDataMV") everywhere;
I had the same problem, but I finally figured it out. This is going to sound ridiculous, but it has everything to do with print page setup. Apparently Excel recalculates it every time you update a cell and this is what's causing the slowdown.
Try using
Sheets("Rapport").DisplayPageBreaks = False
at the beginning of your routine, before any calculations and
Sheets("Rapport").DisplayPageBreaks = True
at the end of it.
I had the same problem. I am far from expert programer. The above answers helped my program but did not solve the problem. I'm running excel 2013 on a 5 year old lap top. Open the program without running it, go to File>OptionsAdvanced, Scroll down to Data and uncheck "Disable undo for large Pivot table refresh...." and "Disable undo for large data Model operation". You could also try leaving them checked but decreasing their value. One or both of these seem to be creating a ever increase file that slows the macro and eventual grinds it to a stop. I assume closing excel clears the files they create so that's why it runs fast when excel is closed and reopened at least for a while. Someone with more knowledge will have to explain what these changes will do and what the consequences are of unchecking them. It appears these changes will be applied to any new spread sheets you create. Maybe these changes would not be necessary if I had a newer more powerful computer.
Essentially, I have an Updata button that takes information from two columns, in two spreadsheets (within 1 book). The overall goal of this code is to take all the values from one column, and then append the values from the other column below it.
Worksheets("Overall Flow").Range("A4:A1004").Value = Worksheets("Active").Range("A2:A1002").Value
Dim i As Integer
For i = 4 To 1004
If Worksheets("Overall Flow").Range("A" & Trim(str(i))) = "" Then
Worksheets("Overall Flow").Range("A" & Trim(str(i)) & ":A" & Trim(str(1000 + i))).Value = Worksheets("Inactive").Range("A2:A1002").Value
i = 1005
End If
Next
For some reason, the first line executes, and then finishes. When I put break points, then do step-by-step, no other steps happen afterwards.
When I run the first line individually, it appears to work fine, but not when:
Worksheets("Overall Flow").Range("A" & Trim(str(i)) & ":A" & Trim(str(1000 + i))).Value = Worksheets("Inactive").Range("A2:A1002").Value
or
Worksheets("Overall Flow").Range("A4:A1004").Value = Worksheets("Inactive").Range("A2:A1002").Value
is present aftwards.
Solution to this is very unusual.
CTRL+BREAK CTRL+BREAK CTRL+BREAK ESC
It just happened to me againg after long time, I was looking for a solution and I came here then this sequence came back to my mind and I tried.
It worked for me, I hope this will help someone.
Update: Tweaked code (now with error checking!)
Main points concerning the current code:
When copying the ACTIVE range, check for last consecutive cell used. This is faster and more effecient than a loop.
Why are you trimming a number you know will not contain spaces?
There's no need to set i = 1005, just use Exit For. This is more effecient and clear to the reader what the intention is. I don't use this in the code below since I avoided looping altogether.
Here's a different way you can do this without any looping, which I think is more clear and effecient. Try this and see if it works for you:
Sub test()
Dim lastRow As Long, offSet As Long
lastRow = Worksheets("Active").Range("A2").End(xlDown).row
'Sanity checks
If IsEmpty(Worksheets("Active").Range("A2")) = True Then offSet = 1: lastRow = 2
If lastRow > 1001 Then lastRow = 1002
Worksheets("Overall Flow").Range("A4:A" & lastRow + 2).Value = _
Worksheets("Active").Range("A2:A" & lastRow).Value
If lastRow < 1002 Then
Worksheets("Overall Flow").Range("A" & lastRow + (3 - offSet) & _
":A1004").Value = Worksheets("Inactive").Range("A2:A1002").Value
End If
End Sub
Notes:
Sanity check 1 is for if A2 is blank in the Active sheet.
Sanity check 2 is for if there are cells beyond A1002 with values in Active sheet.
This is what I am using to test your code. Since I don't know what's in the spreadsheets, I can't reproduce exactly what you're seeing so I'm first putting dummy data into the ranges.
For me it is running fine every time, and I've tried it on 2 different computers - Excel 2003, and Excel 2010.
I set a breakpoint and stepped with F8, and also Shift F8 and both worked fine.
Something may be different with your data (i.e. the first cell being copied over from the inactive sheet is blank and therefore execution stops after processing the first cell -- check that column A4 is not blank), or perhaps some memory has gotten corrupted from having Office being killed.
In a Module I have:
Sub test()
Worksheets("Active").Range("A2:A1002").Value = "active"
Worksheets("Active").Range("A5").Value = ""
Worksheets("Inactive").Range("A2:A1002").Value = "inactive"
Worksheets("Overall Flow").Range("A4:A1004").Value = Worksheets("Active").Range("A2:A1002").Value
Dim i As Integer
For i = 4 To 1004
If Worksheets("Overall Flow").Range("A" & Trim(Str(i))) = "" Then
Worksheets("Overall Flow").Range("A" & Trim(Str(i)) & ":A" & Trim(Str(1000 + i))).Value = Worksheets("Inactive").Range("A2:A1002").Value
i = 1005
End If
Next
End Sub
Have you tried the same code on another computer?
I had this issue and I tracked it down to custom VBA functions used in Conditional Formatting that was processed while application.screenupdating was still set to True.
I'm not sure how consistent this behaviour is but, when a custom VBA function is referred to in a conditional formatting rule, when the screen updates, it will not step through the code even when employing break points or the debug.assert method. Here's the breakdown of what happened:
Context:
2 open workbooks.
Conditional formatting and custom function in question were in workbook1.
The code I was attempting to execute was in workbook2.
Process
I call a procedure in workbook2.
Workbook2's procedure reaches a line executing an autofilter command.
Autofilter command triggers a screen update in all open workbooks (any command that triggers a Worksheet_Change or Worksheet_Calculate event can apply here).
Screen update processes the conditional formatting rules, including the rule in workbook1 calling workbook1's custom function.
Custom function is run in a 'silent' state (i.e. with no interaction with user, ignoring break points and "debug.assert" calls; this appears to be by design as part of the conditional formatting feature)
Custom function finishes execution and ceases all other active code execution.
I fixed my problem by adding a Application.ScreenUpdating = False line at the start to prevent screen updates and, by extension, conditional format processing (but it's best to keep custom functions away from conditional formatting to begin with).
I'm not sure if this is relevant to your situation at all but I hope it helps somebody.
It has already been mentioned in transistor1's answer, but only as a side comment.
I had a similar problem, that VBA code simply stopped executing in the middle of a function. Just before that it also jumped back a few lines of code. No Error Message was shown.
I closed all open Excel programs, and upon reopening the File everything worked fine again.
So my confirmed Answer to this problem is: Corrupted Memory, restart Excel.
Edit: after doing this, I also encountered the Problem that Visual Basic Editor crashed when I tried uncommenting a particular line. So I created a New Excel file and copied my code. Now I don't have any problems anymore.
I ran into the same problem. I had a sub routine that gave random errors throughout the code without giving error messages. By pressing F8, the code would resume.
I found someone had posted a Subroutine he called "ThatCleverDevil" I do not remember the resource or who posted it. It would warn you an error was about to occur. The routine is posted below.
I split the code into component sub-routines. The short snippits ran with no interruption or erros. I created a subroutine that called each snippit. Errors resumed.
They would run individually, but not all together.
RESOLUTION: Between called sub-routines, I ran the following line of code:
Application.Wait Second(Now) + 1
The code then ran without error.
Thanks to whomever it was that wrote ThatCleverDevil. And special thanks to the coder who wrote about Application.Wait.
Sub ThatCleverDevil()
On Error GoTo err
MsgBox "About to error"
err.Raise 12345
MsgBox "Got here after the error"
Exit Sub
err:
Stop: Resume
End Sub
Robert
VBA simply is prone to this issue. I have used it for years in corproate workflows because it is so hardcoded into lots of things, but if possible I would just consider alternatives. If this an ad-hoc project R will be faster and offer more flexibility. If this is more production oriented and meant to handle large volumes I would consider informatica.
To improve the performance I called the function DoEvents inside the loop. It solved the problem for me.