Posts by tstom

Re: Retrieve Data From Website Page

"I would like to grab the Stock value - 3 weeks?
I would like to grab the Stock value - Call?"

Hi Tim...

This information is where? I saw nothing in the pages that even hinted toward the above...

Re: Changing Cell Data By Custom Function

Hi Dave; Kubota...

"standard or non-standard"

Definitely non-standard.

Please post some info about your logical design. What are you trying to do? Under limited circumstances you can use a custom worksheet function to bend the rules. There may be a better alternative for you. In my experience, I have only run into several occasions where it was plausible to use a UDF called from a worksheet cell or workbook name to change properties. Usually, you can utilize the calculate event to get by the limitation.

Re: Get Number From Web Page

Did you look at the html code and decide where to extract from?

Yes. I just searched visually for a couple of landmarks in the source and used them for reference points. It could be a dozen other strings. Of course if the structure of the page changes, the code will break...

Re: Extract Dividend Ex-Date From Yahoo Finance Web Page

You must have Vista. Download the attached.

Re: Worksheet Change Not Firing

How is your change occuring? DDE, for example, does not fire the change event...

Re: Extract Dividend Ex-Date From Yahoo Finance Web Page

Thanks Ken.

Re: VBE Color Pallet

No Richard. All colors are available. I think the OP wants a customized color? Select your userform, and for instance, the backcolor property. Click the dropdown, select the Pallete tab and right click on any of the squares that are reserved for creating custom colors. This would be the last two rows which will all be white if you have not defined any custom colors. There are 48 predefined colors and room enough to save 16 additional custom colors. You can create any color your system will support for your userforms and controls.

Re: Extract Dividend Ex-Date From Yahoo Finance Web Page

Don't forget the parenthesis...

=DividendDate[SIZE="4"]()[/SIZE]

Also, the function must be made accessible by placing it in a standard module...

http://home.fuse.net/tstom/Ozgrid.tparente.0627080128.zip

Re: Maco Functions For Parsing Sub-Strings

Set objRegEx = CreateObject("VBScript.RegExp")

Will offer much more than any native VBA method.
The Like operator is a great tool as well...

Re: Get Number From Web Page

Thanks Dave...

Re: Extract Dividend Ex-Date From Yahoo Finance Web Page

Another option using a function. Format the cell containing the function as date. If you need a string returned, just wrap this in the text function or edit the code...
Place =DividendDate() in some cell. The code goes into a standard module...

Public Function DividendDate() As Date
    Dim Request As Object, s As String, p As Long, sLen As Integer
     
    On Error Resume Next
    Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")
    If Request Is Nothing Then
        Set Request = CreateObject("WinHttp.WinHttpRequest.5")
    End If
    
    Request.Open "GET", "http://finance.yahoo.com/q/ks?s=TOT", False
    Request.Send


    s = Request.Responsetext
    p = InStr(s, "Dividend Date")
    p = InStr(p, s, "yfnc_tabledata1") + 17
    DividendDate = CDate(Mid(s, p, InStr(p, s, "<") - p))
End Function

Re: Get Number From Web Page

From a cell
=LIBORWeek()

Public Function LIBORWeek() As Double
    Dim Request As Object, s As String, p As Long, sLen As Integer
     
    On Error Resume Next
    Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")
    If Request Is Nothing Then
        Set Request = CreateObject("WinHttp.WinHttpRequest.5")
    End If
    
    Request.Open "GET", "http://www.bankrate.com/brm/ratewatch/3mo-libor.asp", False
    Request.Send


    s = Request.Responsetext
    p = InStr(InStr(s, "LIBOR"), s, "F3F3F3") + 8
    LIBORWeek = CDbl(Mid(s, p, InStr(p, s, "<") - p))
End Function

Re: Reference Cells To Run In Subroutine

Look at this code. Whenever you assign a range to a variant, you will get a 1 based two dimensional array. The first dimension for rows, the seconds for columns...

Sub Factorial_2()
     
    Dim factorial, num As Variant, n As Integer
    Dim str As String, i As Integer
     
     ' Generate 20  random numbers and displaying them on A1:A20.
    Randomize -1
    For i = 1 To 20
        Cells(i, 1) = str & (Int(25 * Rnd + 1))
    Next i
     
     ' Reads the previously generated random numbers.
    num = Range("A1:A20")  'DOES NOT WORK FROM HERE ONWARDS
    
    ReDim factorial(1 To 20, 1 To 1)


    For i = 1 To UBound(num, 1)
        factorial(i, 1) = num(i, 1) * i
    Next i
     
     ' Displaying the  answers on B1:B20.
    Range("B1:B20") = factorial
End Sub

Re: Prevent Workbook Save But Allow SaveAs

Re: Prevent Workbook Save But Allow SaveAs

...but it's not as much fun!

Re: Prevent Workbook Save But Allow SaveAs

Quote

If I were using your spreadsheet I would get rather annoyed, no offence Tstom.

Even better. The annoyance will follow every copy made. Code should probably be packed into an addin.

Re: Reference Workbook By Project Name

Of course, as long as the name is unique and it is currently open. Change "ThisWorkbook" to a unique name...

For example, open Excel with default Book1. Add a workbook. In either project, rename ThisWorkbook to ThatWorkbook. Now run the following code from anywhere within the two separate projects that are now open...

Sub Example()
    MsgBox GetWBRefByName("ThisWorkbook").Name
    MsgBox GetWBRefByName("ThatWorkbook").Name
End Sub


Function GetWBRefByName(CodeName As String) As Workbook
    For Each GetWBRefByName In Workbooks
        If GetWBRefByName.CodeName = CodeName Then Exit Function
    Next
End Function

Re: Use Text In Cell As Code

Sure. I don't see the benefit the way you are using it, but, nevertheless, you can do some useful things using one or both of the methods below...

'using callbyname
'for example, call a1 = "ActiveWindow", b1 = "Caption", c1 = "Close"
Sub Example1()
    Dim Obj As Object
    'gets the object named in a1
    Set Obj = CallByName(Application, [a1], VbGet)
    'returns the caption of the activewindow
    MsgBox CallByName(Obj, [b1], VbGet)
    'closes the activewindow
    CallByName Obj, [c1], VbMethod
End Sub


'better to set a reference to Microsoft Script Control
'this example uses late binding
'using the script control if it is available too you
'assume that "ActiveWindow.Close" is in a2
Sub Example2()
    Dim Script1 As Object
    
    Set Script1 = CreateObject("MSScriptcontrol.scriptcontrol.1")
    Script1.Language = "VBScript"
    Script1.AddObject "xlApp", Application
    Script1.ExecuteStatement "xlApp." & [a2]
End Sub

Re: Translucent Userform Label

If you can help understand more precisely what your design is, I can likely help you out.

You have a picture in what? The userform? An image control in the userform? You want to overlay sections of the picture with controls that display a border on mouse over or mouse down, highlighting a part of the picture? Please explain and, if allowed, attach an example...

Re: Prevent Workbook Save But Allow SaveAs

I think this may be what you are looking for?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Result
    
    On Error GoTo Err_Workbook_BeforeSave
    Cancel = True
    Application.EnableEvents = False
    Result = Application.GetSaveAsFilename("", "MS Spreadsheet Files (*.xls), *.xls")


    If Result <> False Then
        If Not (Result = Me.FullName) Then
            Me.SaveAs Result
        Else
            MsgBox "Invalid name selected.  Please select another name for your workbook..."
            Call Workbook_BeforeSave(False, True)
        End If
    End If
    
Err_Workbook_BeforeSave:
    Application.EnableEvents = True
End Sub