Morning
I need some help and not really sure where to begin.
I have an excel workbook, which populates a sheet of data from a SQL stored procedure. There are then a series of pivots off the data, all easy so far. I then create charts off those pivots and move them to their own sheets.
What I want to achieve is a rolling dashboard of those charts, say every 30 seconds, change sheet. I have tried a few things, grabbed a few ideas off this site, but for some reason, the sheets with the charts on will not loop with the others, so in effect I only see my data page and pivot page. Below is some code that I tried to modify for my purpose.
Sub TabShow()
Dim i As Integer
Dim Pause As Double
Pause = 3 'Pause delay
Loops = 3 'How many loops do you want to do
For j = 1 To Loops
For i = 1 To Worksheets.Count
Worksheets(i).Select 'Select the next worksheet
x = Timer
While Timer - x < Pause 'This does the pausing
Wend
Next i
Next j
End Sub
So if anyone has any code that loops through visible sheets including ones of moved charts, I would be eternally grateful.
Cheers
Time arithmetics: in VBA, time is stored in Date, being Date binary equal to Double, being each unit one day. So, Pause = 3 means 3 days!!! Better:
Dim Pause As Date
Pause = #0:0:30# 'Time constant
I recommend also using Now instead of Timer.
Program flow: while running a macro, Excel become irresponsive, unless you use DoEvents:
While Timer - x < Pause 'This does the pausing
DoEvents
Wend
That will ensure your workbook will allow user interaction while macro is running.
However, I do not recommend keeping a macro running while working on it. Check Application.OnTime for a better approach.
Related
I have real-time data streaming from another application into Excel and making =RTD() calls successfully in a complex workbook.
Trying to (a) compare historical data as of a moment in time to current/live data, and, (b) run stats on snapshots taken. Say I have RTD data in 4 rows and 8 columns A1:H4.
The "freeze": Is it possible to push a button (to run a macro) and render, say, row 2 (A2:H2) 'inert', so it's no longer RTD? Basically, copy then-current values and paste them into the same cells (A2:H2) as values, removing the RTD formulas so that the data stops changing at that moment.
The "snapshot": Make a copy of the 3rd row, A3:H3, and paste it into A5:H5 periodically by timer, and have the copy become 'inert', i.e., no longer RTD or linked to RTD in row 5 while row 3 remains RTD. And place a timestamp for this action in cell I5 next to the copy.
This should also theoretically enable me to chart the snapshot data. I can't get RTD data to chart - expected that chart would update as streaming data changed, but charts won't display at all. So that's a secondary but related issue. It would appear that if I can snapshot the data and make it inert, I should be able to chart.
I've tried all kinds of manual processes from paste special/values, go to / special / formulas, highlight, etc. to using a third party tool. I've looked for VBA macros and found one which I'm pasting below, but I can't get it to work (the macro runs on cells to which it's directed, does not error out, but nothing happens). And even if it did work, it would only solve part of the problem as per above.
I do not speak VBA but write enough code in other languages that I should be able to figure out what it does and mod it, if someone is able to offer the base functionality. Any help would be greatly appreciated.
'This code should go in a regular module sheet, and won't work properly if installed anywhere else. _
The next (Dim) statement must occur before any subs or functions.
Dim NextTime As Double
Sub RecordData()
Dim Interval As Double
Dim cel As Range, Capture As Range
Interval = 5 'Number of seconds between each recording of data
Set Capture = Worksheets("Sheet1").Range("A1:A5") 'Capture this column of data
With Worksheets("Sheet2") 'Record the data on this worksheet
Set cel = .Range("A2") 'First timestamp goes here
Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
cel.Value = Now
cel.Offset(0, 1).Resize(1, Capture.Cells.Count).Value = Application.Transpose(Capture.Value)
End With
NextTime = Now + Interval / 86400
Application.OnTime NextTime, "RecordData"
End Sub
Sub StopRecordingData()
On Error Resume Next
Application.OnTime NextTime, "RecordData", , False
On Error GoTo 0
The above code is initiated when the workbook is opened, and stopped when the workbook is closed by code in ThisWorkbook code pane.
'These subs must go in ThisWorkbook code pane. They won't work at all if installed anywhere else!
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopRecordingData
End Sub
Private Sub Workbook_Open()
RecordData
End Sub
End Sub
I've found a lot of questions and answers about issues that feel very close to what I'm working on, but not quite. I have an Excel workbook with a large Data Model connected to two slicers. I need to cycle through every entry in the slicer, allow the workbook to catch up on loading a large number of cube formulas, then copy one particular worksheet over into another.
I've written VBA which does all of this, but I can't for the life of me get the VBA to wait for the workbook to finish uploading before it continues with the rest of the script. I can rule out background refresh-based solutions, which don't apply to OLAP. Various solutions I've found online which recommend waiting for calculations to be complete don't seem to work, the script just barrels right through those lines. The only solution I've seen which seems to apply here involved identifying every cell which would be updated as a result of the slicer change and looping through them until they no longer say #GETTING DATA. For my workbook, this would be hundreds of cells to identify and check and feels very unsustainable.
Even telling the script to Applcation.Wait seems to wait for the selected amount of time during which the workbook pauses getting data.
Setting different values of a slicer connected to a Data Model and automating some output feels like it should be such a common task that we have a solution for it. Any help would be much appreciated.
Running Office 365
Sub generate_all_forecasts()
'Cycle through all products and push forecast values to fcst_output'
Application.ScreenUpdating = True
Dim SC_products As SlicerCache
Dim selection, product_array As Variant
Dim push As Boolean
Set SC_products = ThisWorkbook.SlicerCaches("Slicer_PRODUCT_GROUPING_WRITTEN") 'The product slicer on the Inputs worksheet'
product_array = Range("product_array") 'Named range product_array on Tbl_Codes worksheet'
For Each p In product_array 'For each product'
push = WorksheetFunction.Index(Range("fcst_push_array"), WorksheetFunction.Match(p, product_array, 0)) 'Check if the product has been selected for this run'
If push = True Then
If p = "Major Medical Plan" Then 'If "Major Medical" '
selection = Array("[Query1 1].[PRODUCT_GROUPING_WRITTEN].&[Major Medical Plan - CMM]", _
"[Query1 1].[PRODUCT_GROUPING_WRITTEN].&[Major Medical Plan - GMM]") 'selection will be both CMM and GMM'
Else
selection = Array("[Query1 1].[PRODUCT_GROUPING_WRITTEN].&[" & p & "]") 'Otherwse selection is the single product'
End If
SC_products.VisibleSlicerItemsList = selection 'Change slicer to current selection'
'This is where the script needs to pause until #GETTING DATA is complete'
Application.Run "push_to_output" 'Run the forecast update macro'
End If
Next p
Worksheets("Fcst_Output").Range("B2:B1381").Value = "" 'Clear prior month's comments'
Application.ScreenUpdating = True
End Sub
Solutions which have not worked: Wait time after change slicer in
power pivot, Getting vba to wait before proceeding, Wait
until Application.Calculate has finished
The "solution" I really don't want to use: Force VBA to wait until
power pivot finishes refreshing
Thanks to Tragamor for linking to a thread where they already had a working answer. I included the following immediately after the slicer selection in my VBA and it appears to properly wait until all data fetching is complete:
Dim CalculationState As Long
With Application
CalculationState = .Calculation
.Calculation = xlCalculationAutomatic
.CalculateUntilAsyncQueriesDone
Do Until .CalculationState = xlDone
DoEvents
Loop
.Calculation = CalculationState
End With
Find your Query Properties, and set 'Enable background refresh' to False (Microsoft use True as default).
Then in your code you need to call for RefreshAll and wait for the data to load with the DoEvents. If you want your update of data to run on open you can use this in 'ThisWorkbook' Object.
Private Sub Workbook_Open()
For Each q In ThisWorkbook.Connections
q.Refresh
DoEvents
Next
End Sub
I am creating a calendar where it pulls events from a user inputsheet and places a text box object on another worksheet (Dates across the top and different departments down the left). It currently seperates the events on the top row of each section (i.e. all HR events on top row of HR section). I then run a MACRO to check for overlapping objects and move them down to the next row.
The code I use to move objects is below:
Sub MoveShapes()
'This Macro moves overlapping shapes down to the next row
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim sh As Worksheet
Set sh = wb.ActiveSheet
Dim s1 As Shape
Dim s2 As Shape
Dim CheckOverlap As Boolean
Worksheets("SRTC").Activate
For i = 1 To sh.Shapes.count
If i <= sh.Shapes.count Then
Set s1 = sh.Shapes(i)
Search:
CheckOverlap = False
For Each s2 In Worksheets("SRTC").Shapes
If s2.ID = s1.ID Then GoTo Suit
If s2.Left <= (s1.Left + s1.Width) And s2.Left >= s1.Left _
And s2.Top <= (s1.Top + s1.Height) And s2.Top >= s1.Top Then
s1.Top = s1.Top + 18 ' 32
CheckOverlap = True
Exit For
End If
Suit:
Next
If CheckOverlap = True Then GoTo Search
End If
Next
End Sub
(I found this code in a different forum) This code works but is extremely slow. It is comparing each textbox with all the text boxes on the worksheet. My worksheet has over 3000 shapes and the MACRO takes over 4 hours to run.
Is there a way to write this code to only move objects within certain ranges? (ie only HR section)
Thanks
The first thing would be to use application.screenupdating.
Also some variable declarations are not or badly done (i, Sh).
Don't use Goto. (i may use a do while or do until loop)
Why test on each loop If i <= sh.Shapes.count Thenwich obviously is the case?
You can avoid If s2.ID = s1.ID Then GoTo Suit by not using a for each (wich tests shapes already corrected also), but for j=i+ 1 to sh.shapes.count : set S2=sh.shapes(j) ....`
little reminder : on long IF tests , with several conditions, VBA will test all the conditions before continuing, so instead of testing 4 conditions, test only the 2 more important and then test the two others, for example.
Beware, comments, buttons, and many other stuff is also a shape, so you might need a test of the shape's type (on s1). Avoid unessaceray looping.
On a personal note, i'd use a dictionary and a class type, the whole thing would take max 5 secondes to loop, and no i won't write that code for you.
Your approach is more at your level and is good enough with a bit of code optimization using the hints i gave.
I currently have this Excel VBA code written using Bloomberg API. I am trying to pull data from Bloomberg into Excel using VBA. That is working fine but the problem is that I have another macro that then copies the data from Bloomberg and pastes it in another sheet.
If the data hasn't all been output from Bloomberg then I end up having insufficient data to copy then paste into the other sheet.
Currently, I am using this line of code:
Application.OnTime Now + TimeValue("00:01:45"), "RunAll"
which waits after running the first macro for 1 min 45s till it runs the remaining macros. It is useful but way too much time. Issue is that this is around how long the data takes to output.
Is there any other more efficient way for me to pull in the bloomberg data faster by ensuring that the data gets output into excel faster?
One way to handle it would be when you start your second macro that copies the data, check to see to see if a mid-point cell is empty (something like A100?? Seeing your code would help here...). If so, wait 10 seconds and check again. This will force that second macro to stay in a holding pattern while the first one catches up.
Word of caution though, I would set a max number of loops otherwise if that data doesn't download for some reason it won't hang up your machine.
UPDATE 1:
I wrote out the code below to accomplish what you're trying to do. There are a couple of things you'll need to work into your current code, but it I've purposely made it comment heavy so you should be able to follow. Let me know if this works for you.
Public boolBloombergCompleted As Boolean
Sub GetBloombergData()
'add this line after the data grab is complete
boolBloombergCompleted = True
End Sub
Sub WriteData()
Dim iRow As Integer
Dim boolTimeOut As Boolean
'change the last number as fit, make sure it's larger than the number of rows of data you're pulling in though
For iRow = 1 To 1000
' Check to see if the cell is blank
If Sheet1.Cells(iRow, 1) = vbNullString Then
' If the cell is blank and GetBloombergData has completed then exit sub
If boolBloombergCompleted = True Then
Exit Sub: Debug.Print "WriteData completed"
Else
' Call the wait function below
boolTimeOut = WaitForDataGrabToCatchUp(Sheet1.Cells(iRow, 1))
If boolTimeOut = True Then GoTo TimeOutErr:
End If
End If
' < Add your code to write data in here >
Next iRow
Exit Sub
TimeOutErr:
MsgBox "The write sub timed out while waiting for data to load", vbExclamation
End Sub
Function WaitForDataGrabToCatchUp(rng As Range) As Boolean
Dim StartTime1 As Long
Dim StartTime2 As Long
Dim PauseTime As Long
Dim StopTime As Long
' Set the amount of time to pause between checking the spreadsheet for updates
PauseTime = 5 'seconds
' Set the maximum amount of time to wait before timing out
StopTime = 60 'seconds
' StartTime1 is used for calculating overall time
StartTime1 = Timer
Do While rng = vbNullString
' check if the StopTime has been reached
If Timer - StartTime1 > StopTime Then
WaitForDataGrabToCatchUp = True
Exit Function
Else
' loop for amount of PausedTime (the DoEvents part here is key to keep the data grab moving)
StartTime2 = Timer
Do While Timer < StartTime2 + PauseTime
Debug.Print Timer - StartTime1
DoEvents
Loop
End If
Loop
WaitForDataGrabToCatchUp = False ' means it did not time out
End Function
Hopefully this is an easy one. I have a series of charts in MS Excel that point to data on the same worksheet. The data on the worksheet is calculated using a VBA function. When the data is updated by the VBA function the new numbers are not reflected in the charts that are pointing to them. I tried calling Application.Calculate, but that didn't do the trick. Any thoughts?
UDPATE:
I was able to duplicate this issue on a much smaller scale. Here's how:
Create a new workbook
Rename Sheet 1 to "Summary"
Rename Sheet 2 to "Data"
Open the Summary sheet in the VBA editor and paste the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Parent.Range("worksheetDate") = Target Then
Application.CalculateFull
End If
End Sub
Create a new VBA module
Paste the following code into the new VBA module (I apologize - I can't get Stack Overflow to format this correctly for the life of me - this is the best I could get it to do):
.
Function getWeekValue (weekNumber As Integer, valuesRange As Range) As Integer
Dim aCell As Range
Dim currentDate As Date
Dim arrayIndex As Integer
Dim weekValues(1 To 6) As Integer
currentDate = ThisWorkbook.Names("worksheetDate").RefersToRange.Value
arrayIndex = 1
For Each aCell In valuesRange
If month(currentDate) = month(ThisWorkbook.Sheets("Data").Cells( _
aCell.Row - 1, aCell.Column)) Then
weekValues(arrayIndex) = aCell.Value
arrayIndex = arrayIndex + 1
End If
Next
getWeekValue = weekValues(weekNumber)
End Function
.
Modify the Data worksheet to match the following image:
Select Cell B1 and name the range "worksheetDate"
Duplicate rows 1 through 3 in the following image:
In row 4, under the "Week X" headers, enter the following formula
.
= getWeekValue(1, Data!$A$2:$M$2)
incrementing the first argument to the getWeekValue function by one for each week (e.g., pass 1 for Week 1, 2 for Week 2, 3, for Week 3, etc.
Create a bar graph using cells A3 through E4 as the data
Change the date in cell B2 to a date between 10/1/2010 and 12/31/2010, choosing a month other than the month that is currently in the cell. For example, if the date is 12/11/2010, change it to something like 11/11/2010 or 10/11/2010. Note that both the data and chart update correctly.
Modify the date in cell B2 gain. Note that the data updates, but the chart does not.
Oddly, after a period of time (several minutes) has elapsed, the chart finally updates. I'm not sure if this is because I have been performing other activities that triggered the update or because Excel is triggering an update after several minutes.
Just figured out the solution to this issue as I was suffering from the same.
I've just added "DoEvents()" prior to printing or exporting and the chart got refreshed.
example
Sub a()
Dim w As Worksheet
Dim a
Set w = Worksheets(1)
For Each a In w.Range("a1:a5")
a.Value = a.Value + 1
Next
DoEvents
End Sub
at the end of my changes I close the workbook and reopen it. that seems the easiest and most reliable way to update everything for me.
For example:
Sub a()
Dim w As Worksheet
Dim a
Set w = Worksheets(1)
For Each a In w.Range("a1:a5")
a.Value = a.Value + 1
Next
w.ChartObjects(1).Chart.Refresh
End Sub
This solution worked for me. For the offending worksheet add:
Private Sub Worksheet_Activate()
Dim rngSelection As Range
Dim objChartObject As ChartObject
Dim objChart As Chart
Dim objSeriesCollection As SeriesCollection
Dim objSeries As Series
Dim strFormula As String
Set rngSelection = Selection
For Each objChartObject In Me.ChartObjects
Set objChart = objChartObject.Chart
Set objSeriesCollection = objChart.SeriesCollection
For Each objSeries In objSeriesCollection
strFormula = objSeries.Formula
objSeries.Delete
Set objSeries = objSeriesCollection.NewSeries
objSeries.Formula = strFormula
Next objSeries
Next objChartObject
rngSelection.Select
End Sub
It's possible that the issue is the argument list of getWeekValue, which includes only the week number and the data stream.
If you add a third argument, worksheetDate, then Excel's recalculation engine will be hit on the side of the head with the fact that getWeekValue uses the value held in worksheetDate. In your current implementation, this fact is held only in the VBA code, where it is probably invisible to the recalculation engine.
I write this so hedgingly because I am not privy to the inner workings of the recalculation engine. (Maybe someone who knows about this better than I can comment on my speculation) But I did do a test, in which getWeekValue does have that third argument, and the chart does recalculate properly. Nice added benefit of this approach: you can remove all that other VBA event management. -HTH
I've found that calling this Sub works...
Sub DoAllEvents()
DoEvents
DoEvents
End Sub
BUT
Microsoft cautions about being caught with the next DoEvents executing before the first DoEvents completes, which can happen depending on how often it's called without a delay between calls. Thus DoEvents appears to be acting as a type of non maskable interrupt, and nesting non maskable interrupts can cause the machine to freeze for multiple reasons without any recovery other than reboot.
(Note: If one is not calling the routine above, often and quickly, nesting may not
be an issue.)
Using the following Sub below, which I modified from their suggestion, prevents this from happening.
Sub DoAllEvents()
On Error GoTo ErrorCheck
Dim i
For i = 1 To 4000 ' Start loop. Can be higher, MS sample shows 150000
'I've found twice is enough, but only increased it to four or 4000.
If i Mod 1000 = 0 Then ' If loop has repeated 1000 times.
DoEvents ' Yield to operating system.
End If
Next i
Exit Sub
ErrorCheck:
Debug.Print "Error: "; Error, Err
Resume Next
End Sub
I appears that the number of DoEvents needed is based on the number of background tasks running on your machine, and updating the graph appears to be a background task for the application. I only needed two DoEvents because I call the routine frequently; however, I may end up upping it later if needed.
I also keep the Mod at 1000 so to not change the lag between each DoEvents as Microsoft suggests, preventing nesting. One possible reason you might want to increase the number from 2000 to a higher number is if you system does not update the graph. Increasing this number allows the machine to handle larger numbers of background events that DoEvents might encounter through multiple calls as they are probably on a stack, and the DoEvents event is only allowed to run a specific number of cycles before marking its place in the stack to allow unhandled events and returning, leaving them to be handled on the next call. Thus the need for multiple calls. Changing this to their example of 150000 doesn't appear to slow the machine too much, to play it safe you might want to make it 150000.
Note: the first example Sub with two DoEvents is probably safe depending on how often you call the Sub, however, if called too often, your machine might freeze up. Your call. ;-)
PS: DoEvents will become one of your best calls if you create a lot of nested loops and the program doesn't behave as expected. Fortunately, this is available in all apps that use VBA!
Running Excel 2019.
Added the following to the macro code:
ActiveSheet.ChartObjects(1).Chart.Refresh
DoEvents
The chart now updates during macro execution
UDF getWeekValue has to be marked as volatile.
Function getWeekValue (weekNumber As Integer, valuesRange As Range) As Integer
Application.Volatile '!!
Dim aCell As Range
Dim currentDate As Date
'...
Just an idea: in your Worksheet_Change Sub, insert as the first line:
Application.EnableEvents = False
in order to avoid self-firing events....
Of course set it back to True at the end of the Sub.