Results 1 to 9 of 9

Thread: Help Debug VBA

  1. #1
    Join Date
    Nov 2006
    Posts
    43

    Unanswered: Help Debug VBA

    Hi Everyone,

    When trying to run this vba I’m getting a Debug error. I'm new to VBA so any help is appreciated.

    I'm guessing my placement of statements is incorrect, but I'm sure a more advanced VBA programmer will see what I'm doing wrong

    Code:
    Public Function GetXLStDev(No1 As Double, No2 As Double, No3 As Double, No4 As Double, No5 As Double, No6 As Double) As Double
       Dim objExcel As Object
       Set objExcel = CreateObject("Excel.Application")
       
       
       Let GetXLStDev = objExcel.StDev(No1, No2, No3, No4, No5, No6)
       
       Dim dblSum As Double, dblAvg As Double
    Dim intCount As Integer
    dblSum = (No1 + No2 + No3 + No4 + No5 + No6)
    intCount = IIf(No1 > 0, 1, 0) _
    + IIf(No2 > 0, 1, 0) _
    + IIf(No3 > 0, 1, 0) _
    + IIf(No4 > 0, 1, 0) _
    + IIf(No5 > 0, 1, 0) _
    + IIf(No6 > 0, 1, 0)
    dblAvg = dblSum / intCount
    GetXLStDev = Sqr(((No1 - IIf(No1 = 0, 0, dblAvg)) ^ 2 _
    + (No2 - IIf(No2 = 0, 0, dblAvg)) ^ 2 _
    + (No3 - IIf(No3 = 0, 0, dblAvg)) ^ 2 _
    + (No4 - IIf(No4 = 0, 0, dblAvg)) ^ 2 _
    + (No5 - IIf(No5 = 0, 0, dblAvg)) ^ 2 _
    + (No6 - IIf(No6 = 0, 0, dblAvg)) ^ 2) _
    / (intCount - 1))
       
       objExcel.Quit
       Set objExcel = Nothing
    End Function
    
    Public Function Pause(PauseSeconds As Double)
    
    Dim Start
    Start = Timer
    Do While Timer < Start + PauseSeconds
    DoEvents
    Loop
    
    End Function
    Thank you
    TCB
    End Function[/code]

    Thank you
    TCB
    Last edited by CVLASAK; 01-27-11 at 11:16. Reason: spelling error

  2. #2
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    It would be easier to help you if you could provide the error message you get and the line where this error occurs.
    Have a nice day!

  3. #3
    Join Date
    Nov 2006
    Posts
    43

    VBA Help

    Thanks Sinndho, and sorry about that

    The code just gives me this little error shown below:

    Code:
     IsDimensioned = ((UBound(TheArray) - LBound(TheArray)) >= 0)
    Thanks again
    TCB

  4. #4
    Join Date
    Nov 2006
    Posts
    43
    Thanks Sinndho, I was able to find a different formula that worked. Thanks for your help

  5. #5
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    Here's a solution. It's a bit tricky but it works:
    Code:
    Option Compare Database
    Option Explicit
    
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
    
    Function Test()
    
        Dim Thearray()
        
        Debug.Print IsDimensioned(Thearray)
        
    End Function
    
    Public Function GetArrayDimensions(Thearray As Variant) As Integer
    
        Dim lngArrayPtr As Long
        Dim lngAddress As Long
    
        lngArrayPtr = VarPtrArray(Thearray)
        CopyMemory lngAddress, ByVal lngArrayPtr, ByVal 4
    
        If lngAddress <> 0 Then CopyMemory GetArrayDimensions, ByVal lngAddress, 2
    
    End Function
    
    Function IsDimensioned(Thearray As Variant)
    
        IsDimensioned = GetArrayDimensions(Thearray) > 0
        
    End Function
    
    Public Function VarPtrArray(Thearray As Variant) As Long
    
        CopyMemory VarPtrArray, ByVal VarPtr(Thearray) + 8, ByVal 4
    
    End Function
    Have a nice day!

  6. #6
    Join Date
    Feb 2011
    Posts
    5

    IsDimensioned

    An easier way (I use it):

    Code:
    Public Function IsDimensioned(vArray) As Boolean
        If IsArray(vArray) Then
            Dim a As Integer
            On Error GoTo eUbound
                a = UBound(vArray)
                IsDimensioned = True
        Else
            IsDimensioned = False
        End If
        
        Exit Function
        
    eUbound:
        IsDimensioned = False
    End Function
    Last edited by ELF; 02-11-11 at 13:06. Reason: Formating

  7. #7
    Join Date
    Feb 2011
    Posts
    5
    Another way from Karl E. Peterson's Classic VB Code: NetCam similar to Sinndho's:

    Code:
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
       (Destination As Any, Source As Any, ByVal Length As Long)
    
    Private Function ArrayInitialized(vArray As Variant) As Boolean
       Dim pSA As Long
       ' Make sure an array was passed in:
       If IsArray(vArray) Then
          ' Get the pointer out of the Variant:
          CopyMemory pSA, ByVal VarPtr(vArray) + 8, 4&
          If pSA Then
             ' Try to get the descriptor:
             CopyMemory pSA, ByVal pSA, 4
             ' Array is initialized only if we got
             ' the SAFEARRAY descriptor:
             ArrayInitialized = (pSA <> 0)
          End If
       End If
    End Function

  8. #8
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    Though less intuitive, I prefer methods using "tricks" (such as trying to get a SafeArray descriptor) because I don't like to rely on error handling mechanisms in such cases. This is where a Try... Catch structure is painfully missing in classical VB/VBA.
    Have a nice day!

  9. #9
    Join Date
    Feb 2011
    Posts
    5
    Yes, you're right. But it's a good solution when you don't want to complicate .

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •