VBA Developers Handbook, 2nd Edition. questions on procedures and functions

there's nothing wrong, per se, aside the penultimate line in your Function... i.e. dhCountInCaseS

so onto another issue with the following function:

Public Function dhExtractString(ByVal strIn As String, ByVal intPiece As Integer, _
    Optional ByVal strDelimiter As String = dhcDelimiters) As String
    
    Dim lngPos As Long
    Dim lngpos1 As Long
    Dim lngLastPos As Long
    Dim intLoop As Integer
    
    lngPos = 0
    lngLastPos = 0
    intLoop = intPiece
    
    'if there's more that on delimiter, map them all to the first one
    If Len(strDelimiter) > 1 Then
        strIn = dhTranslate(strIn, strDelimiter, Left$(strDelimitier, 1))
    End If
    strIn = dhTrimAll(strIn)
    Do While intLoop > 0
        lngLastPos = lngPos
        lngpos1 = InStr(lngPos + 1, strIn, Left$(strDelimiter, 1))
        If lngpos1 > 0 Then
            lngPos = lngpos1
            intLoop = intLoop - 1
        Else
            lngPos = Len(strIn) + 1
            Exit Do
        End If
    Loop
    
    End Function

no matter what i try, it always says "Constant expression required" even though it's optional. here is what i tried to use:

Public Sub TestExtract(strIniText As String)
Const dhcdelimiters As String = "=,"

Dim intI As Integer
Dim strText As String
dhcdelimiters = "=,"
intI = 2
Do While True
    strText = dhExtractString(strIniText, intI, "=,")
    If Len(strText) = 0 Then
        Exit Do
    End If
    Debug.Print strText
    intI = intI + 1
Loop
End Sub
Sub test_E_nw()
Const dhcdelimiters As String = "=,"

dhcdelimiters = "=,"
Debug.Print TestExtract("ItemsToBuy=Milk,Bread,Peas")
End Sub

even if i add dhcDelimiters to the function, it still fails at the function. what am i implementing wrong?

thanks @xlent. my goof. appreciate you taking the time to debug this for me. now all working.

ya i had tried that solution but did remove it from the procedures. however when i debug the project, i still get the same error on the function, this line:

Public Function dhExtractString(ByVal strIn As String, ByVal intPiece As Integer, _
    Optional ByVal strDelimiter As String = dhcDelimiters) As String

and it highlights dhcDelimiters.

yes i understand, but even if i comment out the code after the function, when i try to compile, it always says the same error in post #6, so the problem is that the function error's out. i have even copied the code directly from the book, but still get the same error. so what is wrong with the code in the function. that is where the error is. so one note, is that i put the const dhcDelimiters in the actual function, so compile works but when i run one of the procedures, it still goes back to the constant error. what is my limited brain not understanding?

sigh, im without words. i copied everything verbatim from your post. cant get rid of the constant error.

here is two of my public procedure, neither work.

Public Sub test_E_nw()
    Public Const dhcDelimiters As String = "=,"
    TestExtract "ItemsToBuy=Milk,Bread,Peas"
End Sub
Public Sub test_E_nw2()
    Public Const dhcDelimiters As String = "=,"
    Debug.Print TestExtract("ItemsToBuy=Milk,Bread,Peas")
End Sub

everything is in the same module (only have one). should i just move on?

is maybe something wrong with my excel program? or is it just me (Probably). let me attach my workbook, and maybe you can take a peek at it, see if that's whats wrong?

thanks again for sticking the out on me, i knew is was my mistake.

and that helped me solve a couple of other issues that weren't working as procedures. now i can cross off chapter 1. hopefully this makes me a better coder.

so another question on the numbers chapter. this has to do with factorials and recursive factorials. if i run the following procedure, shouldn't they both be the same (or am i not understanding what recursive means?

Sub test_FR_and_F_nw()
    Debug.Print "the factorial of 19 is " & dhFactorial(19)
    Debug.Print "the factorial recursive of 19 is " & dhFactorialRecursive(19)
end sub

the result of running this is:

the factorial of 19 is 1.21645100408832E+17
the factorial recursive of 19 is 19

i did find a typo which i fixed so here is the recursive function:

Public Function dhFactorialRecursive(intX As Integer) As Double
    If intX < 0 Or intX > 170 Then
        dhFactorialRecursive = 0
    ElseIf intX = 0 Then
        dhFactorialRecursive = 1
    Else
        dhFactorialRecursive = intX * dhFactorialRecursive(intX - 1)
    End If
End Function

what am i doing wrong?

thanks, that will help me in several of the Array functions. appreciate the help. got two more that aren't working from chapter 2. will post them separately. then im done with the chapter and on to three.

Originally Posted by bakerman2

OP moves with fast pace through Functions.

well yup, basically i run through each chapter and the ones that don't work i add a "_nw" to. that way i can quickly find the ones that are "not working". by reading each chapter through the end, i can fix a lot of mistakes. but yes, i am cranking out the questions. really glad you guys are lending a hand. this will go a long way into making me a better coder.

thanks, i use notepad++ for some of my coding, just ran a compare. i see the two issues. thanks for pointing that out. one of those "cant see the forest for the tree's issue".

Originally Posted by rorya

I get the same result with both.

sometimes i get hiccups with excel not working as expected, so let me load up my workbook to see if you are getting the same result as I am. if you run this and it works, it just means my version of excel (office 365) is to blame.

what version of excel are you using Rorya?

btw, closing chapter 2, on to dates and times

quick question, does anyone have the CD from this book? looking to get the Holidays.xml or Holidays.mdb file.

so only two procedures are not working from chap 3. here is the first function:

Public Function dhFirstDayInQuarter(Optional dtmDate As Date = 0) As Date
    ' Returns the last day in the quarter specified by the
    ' date in dtmDate.
    Const dhcMonthsInQuarter As Integer = 3
    Dim intMonth As Integer

    'did the caller pass in a date? if not, use the current date
    If dtmDate = 0 Then
        dtmDate = Date
    End If
    
    'calculate the first month in the quarter
    intMonth = Int((Month(dtmDate) - 1) / dhcMonthsInQuarter) * dhcMonthsInQuarter + 1
    
    dhFirstQuaterInYear = DateSerial(Year(dtmDate), intMonth, 1)
End Function

and here is the procedure that doesn't work (prints 12:00:00 AM)

Sub test_FDIQ_nw()
    Debug.Print dhFirstDayInQuarter()
End Sub

is the book wrong or did i make a typo?

thoughts anyone?

thanks, thought it was me (mistyping). so the other function that doesn't work is a doozy for me.

the function thats tripping me up is below:

Private Function GetTimeDelimiter() As String
    Dim lngLCID As Long
    Dim lngLen As Long
    Dim strBuffer As String
    Const MAX_CHARS = 4
    
    lngLCID = GetSystemDefaultLCID()
    strBuffer = Space(MAX_CHARS + 1)
    lngLen = GetLocalInfo(lngLCID, LOCAL_STIME, strBuffer, Len(strBuffer))
    GetTimeDelimiter = Left$(strBuffer, lngLen - 1)
End Function

the procedure that i am running is:

Sub test_FI_nw()
    'this needs GetSystemDefaultLCID & GetLocalInfo which seem to be unsupported on microsoft's site
    Dim dtmStart As Date
    Dim dtmEnd As Date
    On Error GoTo ErrHandler:
    
    
    dtmStart = #1/1/2019 12:00:00 PM#
    dmtEnd = #3/27/2019 8:10:45 AM#
    
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D H")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D H M")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D H M S")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D H:MM")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D HH:MM")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D HH:MM:SS")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "H M")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "H:MM")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "H:MM:SS")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "M S")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "M:SS")
    
ErrHandler:

End Sub

it complains that "GetSystemDefaultLCID" and "GetLocalInfo" are not defined. from reading the text i understand that these are api calls. i googled the internet for both functions but came up empty (microsoft says they are depreciated i think). is there a way to declare the api function calls in the declaration section?

thanks rorya for the zip, helped me to close chapter 3. just so you know i have the ebook, so don't have access to the CD. trying to find out if sybex still has that with the printed book. be so much easier if i could just copy.

so finished with chapter 4 and 5, moving on to 6 "arrgh" = heavy topic. reading on classes from other excel sites. not for the faint of heart.

so i am having an issue with my new class module, getting a run time error 424, object required.

here is my module code:

Sub test_uf2()
Dim cls_btnCode As clsCode
Set cls_btnCode = New clsCode
End Sub

i get the error on the set cls_btnCode statement.

here is my class module:

Dim cls_btnCode As String * 8192
Private Sub Class_Initialize()
btn_Gen_uf2.TextBox1.Value = ""
btn_Gen_uf2.Show
cls_btnCode = btn_Gen_uf2.TextBox1.Value
If cls_btnCode <> "" Then MsgBox cls_btnCode
errhandler:
 MsgBox "you have exceeded 8192 characters " & Len(TextBox1.Value)
End Sub

what am i doing wrong?

it behaves correctly in that it shows the userform, lets me type, tracks the character count. when i press ok, it displays a msgbox which contains the correct text.

Also, you don't want to be breaking encapsulation like that, you should be passing the UserForm object into the class. Oh, and don't use the default instances of user forms, ie. Never use NameOfUserForm.Show

You should be using them properly:

Dim uf As btn_Gen_uf2
Set uf = new btn_Gen_uf2

uf.Show

The default instances won't always be what you expect them to be

thanks @shg and @rorya for that info. @kyle123, here is code that is working but how do i get the data from the code window into the userform that the button generator makes?

here's the module code:

Public uf As btn_Gen_uf2
Sub test_uf2()
    count = 2
    For counter = 1 To count
        Dim cls_btnCode As clsCode
        Set cls_btnCode = New clsCode
    Next counter
End Sub

and here is the class module code:

Dim cls_btnCode As String * 8192
Private Sub Class_Initialize()
Set uf = New btn_Gen_uf2
uf.TextBox1.Value = ""
uf.Label2.Caption = "Count: " & Len(uf.TextBox1.Value)
uf.Show
cls_btnCode = uf.TextBox1.Value
End Sub

and here is my userform code:

Private Sub TextBox1_Change()
    TextBox1.SetFocus
    Label3.Caption = "CommandButton" & counter
    Dim x As Long
    x = Len(TextBox1.Value)
    If x <= 8192 Then
    Label2.Caption = "Count: " & Len(TextBox1.Value)
    End If
    Exit Sub
End Sub

so i tried to put a msgbox in the module code to get the data from the code window but it failed on that line. how do i do that?

so nevermind, i got it working.

i added this (finally worked) to the module and now i can get the info out to the module.

MsgBox uf.TextBox1.Value

now the question is how to get that code into the userform that the button generates. but i have to wait to get home to get the file that does that. didn't update my dropbox.

I've got no idea what that code is supposed to be doing, it doens't seem to make a lot of sense unless you are trying to create multiple userforms (even then it wouldn't work). I don't understand why you are using a class for this, there doesn't seem to be any need?

What do you want the code to do?

so the button generator generates multiple buttons. other than the spacing, i have that working. so now that the class module clsCode is working. i now need that code to 'attach' it to the buttons (buttons need to do something right?) but the file that i need to do this is at home. so the question will have to wait till i can get to my laptop. im sure once i pull this all together, it will make sense (at least i hope that it will). please be patient as this grasshopper is still learning the ropes

Are you still trying to do that IDE automation where you are writing code with code?

yes, isn't that the way im supposed to do it? i thought that my first approach was wrong (in that i did it all at design time).

I don't think you should do any of it at design time. I don't understand why you'd want to.

am i still doing it wrong?

It really depends why you want to do it. Why do you want to do any of it at design time? - What's the purpose of the project?

well at first, all i knew was to create it at design time (showing my lack of knowledge). then you and others said it's not the way to do it. hence writing code that makes code and the use of class modules. i thought that was the right way to do it. and since i didn't have the knowledge, i got the VBA book to learn more. now im on chapter 6 which goes into more detail about class modules. which is why i wrote the clsCode code to get the actual code for the button. do i still not understand the correct way to do this? and the purpose was to do this right (and not at design time, which i said was all that i knew at the time)

If you want to have a userform that you can add a dynamic number of buttons to that have similar behaviour, then do it all at runtime:

Module:

Sub test()
    
    Dim uf As DynamicForm
    Set uf = New DynamicForm
    
    uf.NumberOfButtons = 5
    uf.Show
    
End Sub

Userform:

Private buttonHandlers() As ButtonHandler

Public Property Let NumberOfButtons(ByVal quantity As Long)
    
    Dim hndlr   As ButtonHandler
    Dim x       As Long
    
    ReDim buttonHandlers(quantity)
    
    For x = LBound(buttonHandlers) To UBound(buttonHandlers)
        Set buttonHandlers(x) = New ButtonHandler
        Set buttonHandlers(x).Button = Me.Controls.Add("Forms.CommandButton.1")
        With buttonHandlers(x).Button
            .Left = 10
            .Height = 30
            .Top = (x * .Height) + 10
            .Caption = "Button" & x + 1
            .Width = 80
        End With
    Next x
    
    Me.Width = 110
    Me.Height = 30 * (UBound(buttonHandlers) + 1) + 50
    
End Property


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Cancel = 1: Me.Hide
End Sub

Class:

Public WithEvents Button As MSForms.CommandButton

Private Sub Button_Click()
    MsgBox "Your code goes here"
End Sub

ahh, that is it very helpful. can't wait to get home to do this. thanks for hanging in there.