Change displayed sheet after user inactivity - excel

I am trying to create a piece of code that links to a certain sheet after a certain amount of time of inactivity, what I mean by inactivity is not switching through sheets, so when somebody is clicking on sheets that counts as activity but as soon as its been on the same sheet for an amount of time I want it to switch to sheet 1 (sheet 1 is linked to a presentation and will act much like a screensaver would)
Here is my code in ThisWorkbook
Private nTime As Date
Const proc As String = "SelectIndex"
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Call SetTimer
End Sub
Private Sub SetTimer()
If nTime <> 0 Then
Call Application.OnTime(EarliestTime:=nTime, Procedure:=proc, Schedule:=False)
End If
nTime = Now + TimeValue("00:00:05")
Application.OnTime nTime, Procedure:=proc
End Sub
This works for entering data, when somebody doesn’t enter data for so long it goes to my sheet, but I want it to do it if somebody isn’t switching sheets because nobody has access to enter data anyway, just view the sheets.
It also only works once, when you cancel the presentation and try it again I get the error
"Run time error '1004' Method 'OnTime' of object '_ Application'
Failed "
Just these two problems to overcome and I would really appreciate it if anyone could help J
For information, the procedure SelectIndex is just a macro that switches to sheet 1

If I understand the question correctly, you could trigger the timer within the Sheet_Activate event:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call SetTimer
End Sub

Related

Excel Macro auto-refresh workbook based on user input time

I use a lot of WEBSERVICE calls in my workbook, which is connectionless. Therefore, the only way to periodically refresh values is with a macro. To do so automatically upon workbook open and every 30 seconds thereafter, the following works great:
Dim TimeToRun
Sub auto_open()
Sheets("DataInput").Select
Sheets("DataInput").Range("A1").Activate
Application.CalculateFull
Call ScheduleWorkbookRefresh
End Sub
Sub ScheduleWorkbookRefresh()
TimeToRun = Now + TimeValue("00:00:30")
Application.OnTime TimeToRun, "WorkbookRefresh"
End Sub
Sub WorkbookRefresh()
Application.CalculateFull
Call ScheduleWorkbookRefresh
End Sub
Sub auto_close()
Application.OnTime TimeToRun, "WorkbookRefresh", , False
End Sub
As usual, users claim the refresh interval of 30 seconds is somewhere between too short and too long. So, the idea is to let users fill in the interval they want in cell B9. However, there doesn't seem to be an acceptable way to put a cell number (or variable) into the TimeValue function.
Any ideas on how I might modify the macro to allow users to choose their own refresh interval, other than making the macro available for user edit (similar to handing a loaded gun, safety off, to a troop of chimpanzees)?
Use TimeToRun = Now + TimeValue("00:00:" & Sheets("DataInput").Range("A1").Value)

Don't execute Worksheet_Calculate event on Workbook_Open

I have an excel workbook.
In one of the worksheets I make use of the Worksheet_Calculate event. This works fine. However when the workbook is first opened I do not want MyFunction to be called. What is the best away to do this?
My only idea so far is the following (I don't like this though). On the workbook open method put a time stamp in one of the worksheets and then have an if statement in my worksheet_calculate and if the current time is 1 minute past the time stamp (that was created on the workbook_open event) run the code otherwise don't.
Thinking there must be a better way though?
Private Sub Worksheet_Calculate()
MyFunction()
End Sub
Update
The reason I do not want my code to execute when the workbook opens is because there are some Bloomberg formulas that take a little time to execute so initially some of the cell values are #NA.
This causes a type mismatch error - any errors that happen are logged and an e-mail is automatically sent. So every time the workbook is opened there is an 'error' as the bloomberg formulas have not updated straight away
The code below should work for you.
The first time calculate is called it sets the flag to allow future calls to process. This means the first call to calculate does not process your code.
ThisWorkbook Code:
Private Sub Workbook_Open()
bFunctionFlag = False
End Sub
Sheet Code:
Public bFunctionFlag As Boolean
Private Sub Worksheet_Calculate()
If bFunctionFlag = True Then Call MyFunction
bFunctionFlag = True
End Sub
Private Function MyFunction()
MsgBox "Calculate"
End Function
In the workbook open event you can have
Private Sub Workbook_Open()
Application.EnableEvents = False
'Run Workbook Open code
Application.EnableEvents = True
End Sub
or if you need events to run from external services then do something similar with a public variable. Eg Dim wbOpenEventEnded as Boolean

Delay Macro Run, Excessive Countifs

I am running a macro that opens a file referencing the one I am working in, pastes the relevant items as values into a separate sheet and makes a workbook out of that sheet.
The reason why I am doing this is because there are several thousand countifs, averageifs, and processor-intensive ilk.
The program runs from start to finish, just fine. The issue is that only a few of the items are calculated before the copy/paste operation and so I get a lot of #VALUE errors on the copy of the sheet with the formulas--even though the formulas are calculating correctly on further inspection.
I suspect the correct course of action is to delay the run until the sheet finishes calculating. Any and all help would be appreciated.
EDIT: I've tried all manner of application.calculations and nothing seems to be working. The links and items calculate normally if I open manually and let the processor do its thing. The only items that calculate are the ones that contain "COUNTA" somewhere in it. Is it possible that the application calculation methods don't work with Countifs and the like?
Shouldn't be that hard to do - the Worksheet object has a Calculate property that fires after it calculates. You can add a custom property to the worksheet that exposes a flag that you set after it is done calculating. In the worksheet code that has the time consuming calculation...
Option Explicit
Private can_copy As Boolean
Public Property Get CopyOK()
CopyOK = can_copy
End Property
Private Sub Worksheet_Calculate()
can_copy = True
End Sub
Private Sub Worksheet_Activate()
can_copy = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
can_copy = False
End Sub
'For volitile functions.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
can_copy = False
End Sub
...and in the calling code:
Dim book As Workbook
Set book = Application.Workbooks.Open("C:\foobar.xlsm")
Do While Not book.Worksheets("Sheet1").CopyOK
DoEvents
Loop
'Do your thing...
Note that I likely missed some events that would trigger a recalculation, but this should cover the scenario of just opening it.
So, I found a means for this to work:
Do Until Application.CalculationState = xlDone
Application.Calculate
While Application.CalculationState <> xlDone
MsgBox Application.CalculationState
DoEvents
Wend
Loop
It was a solution I sort of applied from Siddharth Rout : Wait until Application.Calculate has finished
Thank you everyone for your help!

Creating a VBA Refresh Macro in Smart View for Oracle

Does anyone know the VBA Code that I need to use so that I can automatically “Refresh” and “Refresh All” using EPM (Hyperion) Smartiew? The “Refresh” function pulls the data into Excel on the active tab where the “Refresh” all function refreshes all tabs in the Workbook.
I’d like to create a simple macro attached to a command button in Excel and I’m not sure which VBA code to use.
I tried recording a macro where by I simply starting recording clicked refresh and stop recording although this did not work.
I tried this code just for the refresh:
Declare Function HypMenuVRefresh Lib "HsAddin.dll"() As Long
Sub MRetrieve()
X = HypMenuVRefresh()
End Sub
But received an error message saying that I had to update the declare method for use with a 64 bit system (I am using a 64 bit system).
Does anyone know how I could create this automatic Macro to refresh the data?
Any help would be much appreciated!
The declaration for x64 in VBA is not correct.
Try:
Private Declare PtrSafe Function HypMenuVRefresh Lib "HsAddin" () As Long
Sub refreshWS()
Dim Count, i As Integer
i = 1
Count = Worksheets.Count
Do While i <= Count
Sheets(i).Select
MsgBox Sheets(i).Name
Call HypMenuVRefresh
i = i + 1
Loop
MsgBox "done"
End Sub
Use the function calls that basically simulate pressing the buttons!
Refresh current worksheet
Declare Function HypMenuVRefresh Lib "HsAddin.dll" () As Long
lngReturn = HypMenuVRefresh()
Refresh All Worksheets
Declare Function HypMenuVRefreshAll Lib "HsAddin.dll" () As Long
lngReturn = HypMenuVRefreshAll()
*NOTE : Return value of 0 is 'OK'
HypRetrieveRange can refresh or update a range of information, there are also a number of other functions that might suit what you want depending on how much information you need to refresh. Did you import the entire smartview.bas file like they recommended?
Sub Refresh()
'
' Refresh Macro
' Macro recorded 8/12/2011 by joao-oliveira
'
Dim oBar As CommandBar
Set oBar = Application.CommandBars("Worksheet Menu Bar")
oBar.Controls("Hyperion").Controls("Refresh").Execute
End Sub
This worked for me. You'll be able to assign this macro to any button. Instead of using the refresh all function, I am using the HypMenuVRefresh function within each worksheet.
Sub refreshWS()
Dim Count, i As Integer
i = 1
Count = Worksheets.Count
Do While i < Count
Sheets(i).Select
Call HypMenuVRefresh
i = i + 1
Loop
MsgBox "done"
End Sub
Create a button and assign it a new subroutine. Use the call command to call the public function.
Sub RefreshHFM()
'
' RefreshHFM Macro
'
Call HypMenuVRefreshAll
'
End Sub

Changes of tab color - macro - does not work properly

I have a macro which changes the tab colors. If there is any value in the sheet then the tab changes into green. If there is nothing then it changes into red. I combined this macro from the ready ones found on the internet. Currently I put this to ThisWorkbook but in this instance it applies to every sheet in the workbook and I wanted only those 2 sheets specified by me ("Our Data" and "Test"). I split this macro to sheets located above ThisWorkbook but then it doesn't work. Can somebody help me to amend it?
Private Sub Workbook_SheetChange(ByVal Test As Object, ByVal Target As Range)
If Cells.Find("*") Is Nothing Then
Test.Tab.ColorIndex = 3
Else
Test.Tab.ColorIndex = 10
End If
End Sub
Private Sub Workbook_SheetChange2(ByVal Test As Object, ByVal Target As Range)
If Cells.Find("*") Is Nothing Then
Our Data.Tab.ColorIndex = 3
Else
Our Data.Tab.ColorIndex = 10
End If
End Sub
You can't split it this way... Delete the second one and improve first as presented below:
Private Sub Workbook_SheetChange(ByVal Test As Object, ByVal Target As Range)
If Test.Name = "Our Data" Or Test.Name = "Test" Then
If Cells.Find("*") Is Nothing Then
Test.Tab.ColorIndex = 3
Else
Test.Tab.ColorIndex = 10
End If
End Sub
Keep it where you have it now (in ThisWorkbook module)
EDIT- additional information for all who will want to use it. Presented idea is very inefficient. The event will fire each time when any changes would be made in any of cell in any of sheet. Please consider using other events. I would suggest to use SheetActivate of SheetDeactivate.

Resources