I have a workbook which I use to value my investment portfolio. It includes UDFs which scrape data from some websites where Excel's stocks data type is not available. The UDFs work well but they take a little time to calculate. I would like for the UDFs to only run when I hit F9 but not when I open the workbook but I can't work out how to achieve this. Is there something like "If running as part of loading up the workbook then do this..."?
I have Calculation=Automatic and Application.Volatile(False).
Thank you for any suggestions.
I'm not sure it's necessary, here is one of the UDFs:
`
Function GetLSEPrice(ticker As String) As Double
Application.Volatile (False)
Dim driver As New ChromeDriver
Dim url As String
Dim y As Selenium.WebElement
url = "https://www.londonstockexchange.com/stock/" & _
ticker & _
"/united-kingdom/company-page"
driver.AddArgument "--headless"
driver.Get url
Set y = driver.FindElementByClass("price-tag")
GetLSEPrice = CDbl(y.Text)
End Function
`
The following should do it;
Step 1) - Create a New Property in your Workbook - to count how many times the various UDFs are called
Step 2) - Add Code in the UDF's to Test that Counter
I've Added Code to the SheetSelectionChange Event (Just to help trigger the UDF's)
AS follows;
Public UDFCallCtr As Long
Private Sub Workbook_Open()
ThisWorkbook.UDFCallCtr = 1 ' Not Really Reqd
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.CalculateFull
End Sub
This is the UDF I've tested it with
Public Function UDFTester() As String
If ThisWorkbook.UDFCallCtr > 5 Then ' Change 5 to any value that works for you
' Put you Code here
UDFTester = "Time is now " & Now()
' Done
Else
UDFTester = "NOT READY YET"
ThisWorkbook.UDFCallCtr = ThisWorkbook.UDFCallCtr + 1
End If
End Function
The following may help show where the code goes
Related
I have a quite simple macro to hide the row the checkbox is in when clicked. It works but the problem is there are A LOT of rows.
Private Sub CheckBox3_Click()
[3:3].EntireRow.Hidden = CheckBox3.Value
Range("AB3").Value = True
End Sub
I of course can make a separate macro for every single checkbox i have (all 250 of them), but i hope i can avoid a macropage that is 6 pages long.
My question is: is there a way to combine it into 1? the only thing that is different for all of them is the number (in the example its 3).
You should create those CheckBoxes programatically and create Class Module to handle events. Here is example how to achieve it:
ClassModule i.e. MyCheckBox:
Option Explicit
Dim WithEvents m_CheckBox As MSForms.CheckBox
Dim m_Row As Long
Public Sub CreateCheckBox(ByVal sh As Worksheet, ByVal rowNumber As Long)
m_Row = rowNumber
Set m_CheckBox = sh.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=sh.Cells(rowNumber, 1).Left, Top:=sh.Cells(rowNumber, 1).Top, Width:=108, Height:=19.5).Object
End Sub
Private Sub m_CheckBox_Change()
MsgBox "I'm in row " & m_Row & " MyValue is " & m_CheckBox.Value
End Sub
Module using this code:
Option Explicit
Dim chkBoxes As New Collection
Public Sub test()
Dim sh As Worksheet
Dim chk As MyCheckBox
Set sh = ActiveSheet
Set chk = New MyCheckBox
chk.CreateCheckBox sh, 1
chkBoxes.Add chk
Set chk = New MyCheckBox
chk.CreateCheckBox sh, 2
chkBoxes.Add chk
End Sub
Of course method CreateCheckBox has to be adjusted to your needs (my one is creating checkbox in first column). Global collection in module is required otherwise classes are destroyed automatically when sub is finished and events are never fired. If workbook is opened and closed then this code must be upgraded to either:
1) Recreate classes on Workbook event i.e. open
2) Recreate CheckBoxes every time workbook is opened
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
I have a worksheet that automatically gets updated with live stock price data. At the moment we have a very messy solution of copying periodically to the clipboard and manipulating the data from there.
Is it possible to instead automatically export data to CSV every time a price change is detected? I'm guessing it would involve VBA.
You can treat excel file as a data source and you may query it.
See google results: http://www.google.ro/#sclient=psy&hl=ro&q=excel+data+source+sql+query&aq=0&aqi=g1&aql=&oq=&pbx=1&fp=b0efac6ab816e29b
I will try to find a specific article for you.
I'd suggest the following strategy:
Fire up your worksheet and switch into "design mode"
Right-click the button which updates the stock info and try to find out to which macro the button is bound to
Open the VBA editor (ALT+F11)
Choose the "Workbook"-Section
From there select the "Open" Event/Method
Write a simple loop with a delay which calls the macro mentioned above periodically and programmatically save the excel-sheet as CSV
The code would be somthing like this (can't check it as I don't have access to excel right now):
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub Workbook_open()
Do While True
Call name_of_macro()
ActiveWorkbook.SaveAs Filename:= _
"c:\path/to/file.csv", FileFormat:=xlCSV _
, CreateBackup:=False
Sleep 10000 'Sleep 10 seconds
Loop
End Sub
This example is just intended to show a rough solution. As Jean-Francois pointed out, this piece of code will NOT update everytime a change is detected, it will update every 10 seconds, even if the data is still the same.
You can use an Application.OnTime to set up a function to get called on a regular basis.
The following function gets called by Excel every 30 seconds. Either call it once to kick off the schedule or just set Application.OnTime once when your worksheet opens to get it running.
Public Sub DoExport()
' do your export to CSV logic here
Application.OnTime Now + TimeValue("00:00:30"), "DoExport"
End Sub
This will do the trick:
Sub LoadNewValuesAndCheckForChange()
Dim rngMyValues As Range
Dim varBefore As Variant
Dim varAfter As Variant
Dim iRow As Long
Dim iCol As Long
Dim booValuesHaveChanged As Boolean
Set rngMyValues = Range("B4:D9") ' Or wherever your data is
varBefore = rngMyValues ' Save old values in an array
' Call the function that loads your new stock prices here...
varAfter = rngMyValues ' Get new values
' Loop through all cells to see if anything has changed.
booValuesHaveChanged = False
For iRow = LBound(varBefore, 1) To UBound(varBefore, 1)
For iCol = LBound(varBefore, 21) To UBound(varBefore, 21)
If Not varAfter(iRow, iCol) = varBefore(iRow, iCol) Then
' Change detected!
booValuesHaveChanged = True
End If
Next iCol
Next iRow
If booValuesHaveChanged Then
' Save .csv file with timestamp in filename
ActiveWorksheet.SaveAs _
Filename:="c:\myfile" & Format(Now, "yyyymmddhhnnss") & ".csv", _
FileFormat:=xlCSV
End If
End Sub
This is Excel 2003.
I'd like to know how long it takes an external query to complete and then update a cell in my spreadsheet with that ET. I have the following, but it doesn't work because the ET is only as long as it takes to initiate the refresh:
Sub Refresh()
Dim StartTime, EndTime, ET
StartTime = Timer
ActiveWorkbook.RefreshAll
EndTime = Timer
ET = Format(EndTime - StartTime, "Fixed")
Range("H27").Value = ET
MsgBox (ET)
End Sub
So the ET is about 1 second, even though the data fetch takes a good 10 minutes.
The easy way out is to set background refresh to false, but this blocks the whole application and makes life miserable for a long time.
Is there some kind of signal or exception that I can catch in VBA that indicates "oh, a background refresh is done; now you can stop your timer and calculate the ET"?
Thanks!
I guess you need to use the AfterRefresh event.
Here is a forum discussion with a happy ending and examples.
Pasting the example from the referred page, just for link independence (you should add your timer storage and arithmetic):
This code goes on a Module:
Dim X As New Class1
Sub Initialize_It()
Application.DisplayAlerts = False
Application.ScreenUpdating = True
diropen = "C:\Desktop\"
Workbooks.Open diropen & "Test.xls" , UpdateLinks:=0
Set X.qt = Workbooks("Test.xls").Sheets("Sheet1").QueryTables(1)
ActiveWorkbook.RefreshAll
End Sub
This code goes on a Class Module:
Public WithEvents qt As QueryTable
Private Sub qt_AfterRefresh(ByVal Success As Boolean)
' Declare variables.
Dim a As Integer
Dim My_Prompt As String
' Initialize prompt text for message box.
My_Prompt = "Data refreshed or canceled."
' Displays message box before refresh (or cancel) occurs.
MsgBox My_Prompt
ActiveWorkbook.Save
Workbooks("Test.xls").Close
End Sub
I have three questions about VBA and controlling/manipulating new windows.
I have several sheets set up.
Master | Worksheet1 | Worksheet2 | Notes | Work Orders | Contact Info
1) I have WorkSheet_Activate functions set up on Notes, Work Orders, Contact Info that open up all three sheets in seperate windows and arrange them vertically.
Private Sub WorkSheet_Activate()
ActiveWindow.NewWindow
ActiveWindow.NewWindow
Windows.Arrange ArrangeStyle:=xlVertical
Sheets("Notes").Select
Windows("Mastersheet.xlsm:2").Activate
Sheets("Work Orders").Select
Windows("Mastersheet.xlsm:1").Activate
Sheets("Contact Info").Select
End Sub
The problem with it is that if I can activate these sheets again, it will open more windows. I would like the code to detect if the windows are already open and break if it is.
2) Now, when I navigate to a different sheet, such as Master, I would like the extra windows to close and for the Master sheet to be active. I was using the following code on the Master sheet.
Private Sub WorkSheet_Activate()
Windows("Mastersheet.xlsm:2").Activate
ActiveWindow.Close
Windows("Mastersheet.xlsm:1").Activate
ActiveWindow.Close
ActiveWindow.WindowState = xlMaximized
End Sub
The problem with this code is that if the extra windows aren't open then it will error out. Can I do a logic check of some sort to get this to work? I don't know what values to check...
3) The last problem is that there are new sheets generated dynamically by macros within the workbook. Those new worksheets won't carry the above code that closes multiple windows and focuses on the activesheet. Is there a different object that I should be putting the code to so that it applies to the Master | Worksheet1 | Worksheet2 sheets and any new sheets?
That's a lot of questions. :) For 3, you need to move your events out of where they are and into a custom class module that handles application level events. Start by inserting a new class module into your project (Insert - Class Module). Name that module CAppEvents (F4 to show the property sheet where you can change the name). Then paste this code into the class module
Option Explicit
Private WithEvents mobjWb As Workbook
Private Sub Class_Terminate()
Set mobjWb = Nothing
End Sub
Public Property Get wb() As Workbook
Set wb = mobjWb
End Property
Public Property Set wb(objwb As Workbook)
Set mobjWb = objwb
End Property
Private Sub mobjWb_SheetActivate(ByVal Sh As Object)
Dim wn As Window
If IsSplitSheet(Sh) Then
If Not IsSplit(Sh) Then
CreateSplitSheets Sh
End If
Else
If IsSplit(Sh) Then
For Each wn In Me.wb.Windows
If wn.Caption Like Me.wb.Name & ":#" Then
wn.Close
End If
Next wn
ActiveWindow.WindowState = xlMaximized
Sh.Activate
End If
End If
End Sub
Private Function IsSplitSheet(Sh As Object) As Boolean
Dim vaNames As Variant
Dim i As Long
IsSplitSheet = False
vaNames = GetSplitSheetNames
For i = LBound(vaNames) To UBound(vaNames)
If vaNames(i) = Sh.Name Then
IsSplitSheet = True
Exit For
End If
Next i
End Function
Private Function IsSplit(Sh As Object) As Boolean
Dim wn As Window
IsSplit = False
For Each wn In Me.wb.Windows
If wn.Caption Like Sh.Parent.Name & ":#" Then
IsSplit = True
Exit For
End If
Next wn
End Function
Private Sub CreateSplitSheets(Sh As Object)
Dim vaNames As Variant
Dim i As Long
Dim wn As Window
Dim wnActive As Window
vaNames = GetSplitSheetNames
Set wnActive = ActiveWindow
For i = LBound(vaNames) To UBound(vaNames)
If vaNames(i) <> Sh.Name Then
Set wn = Me.wb.NewWindow
wn.Activate
On Error Resume Next
wn.Parent.Sheets(vaNames(i)).Activate
On Error GoTo 0
End If
Next i
Sh.Parent.Windows.Arrange xlVertical
wnActive.Activate
Sh.Activate
End Sub
Private Function GetSplitSheetNames() As Variant
GetSplitSheetNames = Array("Notes", "Work Orders", "Contact Info")
End Function
Then insert a standard module (Insert - Module) and paste this code
Option Explicit
Public gclsAppEvents As CAppEvents
Sub Auto_Open()
Set gclsAppEvents = New CAppEvents
Set gclsAppEvents.wb = ThisWorkbook
End Sub
Here's what's happening: When you open the workbook, Auto_Open will run and it will create a new instance of your CAppEvents object. Since gclsAppEvents is public (aka global) it won't lose scope for as long as the workbook is open. It will sit there listening for events (because we used the WithEvents keyword in the class).
In the class there's a sub called mobjWb_SheetActivate. This is what will fire whenever any sheet in this workbook is activated. First it checks if the sheet you just activated (the Sh variable) is one of the ones you want to split (using IsSplitSheet). If it is, it then checks to see if it already has been split. If not, it splits them.
If Sh (the sheet you just activated) is not one of the 'split sheets', then it checks to see if a split has been done (IsSplit). IF it has, it closes all the split windows.
If you even want to add, change, or delete sheets that cause a split, you go to the GetSplitSheetNames function and change the Array arguments.
Because we're using a custom class and sniffing for events at the workbook level, you can add and delete sheets all you want.
1) To test if a window is already open, use this function
Function IsWindowOpen(windowTitle As String) As Boolean
Dim i As Long
For i = 1 To Windows.Count
If Windows(i).Caption = windowTitle Then
IsWindowOpen = True
Exit Function
End If
Next
IsWindowOpen = False
End Function
For example:
if not IsWindowOpen("Mastersheet.xlsm:2") then
' code to open windows
end if
2) You can reuse the function again, same idea:
if IsWindowOpen("Mastersheet.xlsm:2") then
' code to close windows
end if
3) Add your code to a module, not to a sheet. Then call the routine from the macro which adds the new sheets after it has done this. If this macro is in a different module, you may have to make sure your Sub is public.