Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Help Debug VBA 1

Status
Not open for further replies.
TJVFree

TJVFree

Technical User
Nov 22, 2010
236
US
Hi Everyone,

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

I'm guessing my placment of statements are incorrect, but I'm sure a move advaced 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
 
Sort by date Sort by votes


hi,

On what statement does your function error?

What IS the error meesage?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
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))

all of this is highlighted with the arrow pointing to ->/ (intCount - 1))
 
Upvote 0 Downvote
Run-time error '6':

Overflow

Then this part is highlighted:
Code: 
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))

all of this is highlighted with the arrow pointing to ->/ (intCount - 1))


 
Upvote 0 Downvote


What is the value of intCount at the debug. Use the Watch Window to discover this value. I'll bet that it's 1 and you're dividing by ZERO.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
As previously provided you can simply use the getSTDEV code below. Works for any amount of values.

Code: 
Public Function getSTDev(ParamArray varVals() As Variant) As Variant
  Dim varVal As Variant
  Dim intcount As Integer
  Dim Arr() As Variant
  For Each varVal In varVals
    If IsNumeric(varVal) Then
      Arr = AddElement(Arr, varVal)
    End If
  Next varVal
  getSTDev = StdDev(Arr)
End Function
supporting functions
Code: 
Function StdDev(Arr() As Variant) As Variant
     Dim i As Integer
     Dim avg As Single, SumSq As Single
     Dim k As Integer
     avg = Mean(Arr)
     For i = LBound(Arr) To UBound(Arr)
          SumSq = SumSq + (Arr(i) - avg) ^ 2
          k = k + 1
     Next i
     StdDev = Sqr(SumSq / (k - 1))
End Function

Public Function AddElement(ByVal vArray As Variant, ByVal vElem As Variant) As Variant
      ' This function adds an element to a Variant array
      ' and returns an array with the element added to it.
      Dim vRet As Variant ' To be returned
      If IsEmpty(vArray) Or Not IsDimensioned(vArray) Then
          ' First time through, create an array of size 1.
          vRet = Array(vElem)
      Else
          vRet = vArray
          ' From then on, ReDim Preserve will work.
          ReDim Preserve vRet(UBound(vArray) + 1)
          vRet(UBound(vRet)) = vElem
      End If
      AddElement = vRet
  End Function

Public Function IsDimensioned(ByRef TheArray) As Boolean
      If IsArray(TheArray) Then ' we need to test it! otherwise will return false if not an array!
                      ' If you put extensive use to this function then you might modify
                      ' it a lil' bit so it "takes in" specific array type & you can skip IsArray
                      ' (currently you can pass any variable).
        On Error Resume Next
            IsDimensioned = ((UBound(TheArray) - LBound(TheArray)) >= 0)
        On Error GoTo 0
    Else
        'IsDimensioned = False ' is already false by default
        Call Err.Raise(5, "IsDimensioned", "Invalid procedure call or argument. Argument is not an array!")
    End If
End Function

Public Function HasDimension(ByRef TheArray, Optional ByRef Dimension As Long = 1) As Boolean
    Dim isDim As Boolean
    Dim ErrNumb As Long
    Dim LB As Long
    Dim errDesc As String
    'HasDimension = False
    
    If (Dimension > 60) Or (Dimension < 1) Then
        Call Err.Raise(9, "HasDimension", "Subscript out of range. ""Dimension"" parameter is not in its legal borders (1 to 60)! Passed dimension value is: " & Dimension)
        Exit Function
    End If
    
    On Error Resume Next
        isDim = IsDimensioned(TheArray) 'IsArray & IsDimensioned in one call. If Err 5 will be generated if not Array
        ErrNumb = Err.Number
        If ErrNumb <> 0 Then
            errDesc = Err.Description
        End If
    On Error GoTo 0
    
    Select Case ErrNumb
        Case 0
            If isDim Then
                On Error Resume Next
                    LB = LBound(TheArray, Dimension) 'just try to retrive Lbound
                    HasDimension = (Err.Number = 0)
                On Error GoTo 0
            End If
        Case 5
            Call Err.Raise(5, "HasDimension", "Invalid procedure call or argument. Argument is not an array!")
        Case Else
            Call Err.Raise(vbObjectError + 1, "HasDimension", _
                "This is unexpected error, caused when calling ""IsDimensioned"" function!" & vbCrLf & _
                "Original error: " & ErrNumb & vbCrLf & _
                "Description:" & errDesc)
    End Select
End Function

Function Mean(Arr() As Variant)
     Dim Sum As Single
     Dim i As Integer
     Dim k As Integer
     Sum = 0
     For i = LBound(Arr) To UBound(Arr)
         k = k + 1
         Sum = Sum + Arr(i)
     Next i
     Mean = Sum / k
     'MsgBox Mean
End Function.
 
Upvote 0 Downvote
This is awesome MajP. As you probably know by now, I'm very new to VBA.
This is what I did:
1.) Created a new Module
2.) Took your code and pasted it into it
3.) Went to my standard Dev query and placed this
4.) Standard Deviations: getSTDEV([May],[June],[July],[Aug],[Sept],[Oct])

and got this error
Run-time erro '9';
Subscript out of range

Then this part was highlighted
IsDimensioned = ((UBound(TheArray) - LBound(TheArray)) >= 0)

Is there a step I’m doing incorrectly?
 
Upvote 0 Downvote
Although I could not replicate that exact error, I could get a similar error if I have a record with only one value and the rest null, or only null values. This should account for those cases
Replace all of the previous code.
Code: 
Public Function getSTDev(ParamArray varVals() As Variant) As Variant
  Dim varVal As Variant
  Dim intcount As Integer
  Dim Arr() As Variant
  For Each varVal In varVals
    If IsNumeric(varVal) Then
      Arr = AddElement(Arr, varVal)
    End If
  Next varVal
  getSTDev = StdDev(Arr)
End Function

Function StdDev(Arr() As Variant) As Variant
     Dim i As Integer
     Dim avg As Single, SumSq As Single
     Dim k As Integer
     If Not HasDimension(Arr) Then Exit Function
     If Not UBound(Arr) = LBound(Arr) Then
       avg = Mean(Arr)
       For i = LBound(Arr) To UBound(Arr)
          SumSq = SumSq + (Arr(i) - avg) ^ 2
          k = k + 1
        Next i
        If k > 1 Then
          StdDev = Sqr(SumSq / (k - 1))
        End If
     End If
End Function
Public Function AddElement(ByVal vArray As Variant, ByVal vElem As Variant) As Variant
      ' This function adds an element to a Variant array
      ' and returns an array with the element added to it.
      Dim vRet As Variant ' To be returned
      If IsEmpty(vArray) Or Not IsDimensioned(vArray) Then
          ' First time through, create an array of size 1.
          vRet = Array(vElem)
      Else
          vRet = vArray
          ' From then on, ReDim Preserve will work.
          ReDim Preserve vRet(UBound(vArray) + 1)
          vRet(UBound(vRet)) = vElem
      End If
      AddElement = vRet
  End Function
Public Function IsDimensioned(ByRef TheArray) As Boolean
      If IsArray(TheArray) Then ' we need to test it! otherwise will return false if not an array!
                      ' If you put extensive use to this function then you might modify
                      ' it a lil' bit so it "takes in" specific array type & you can skip IsArray
                      ' (currently you can pass any variable).
        On Error Resume Next
            IsDimensioned = ((UBound(TheArray) - LBound(TheArray)) >= 0)
        On Error GoTo 0
    Else
        'IsDimensioned = False ' is already false by default
        Call Err.Raise(5, "IsDimensioned", "Invalid procedure call or argument. Argument is not an array!")
    End If
End Function
Public Function HasDimension(ByRef TheArray, Optional ByRef Dimension As Long = 1) As Boolean
    Dim isDim As Boolean
    Dim ErrNumb As Long
    Dim LB As Long
    Dim errDesc As String
    'HasDimension = False
    
    If (Dimension > 60) Or (Dimension < 1) Then
        Call Err.Raise(9, "HasDimension", "Subscript out of range. ""Dimension"" parameter is not in its legal borders (1 to 60)! Passed dimension value is: " & Dimension)
        Exit Function
    End If
    
    On Error Resume Next
        isDim = IsDimensioned(TheArray) 'IsArray & IsDimensioned in one call. If Err 5 will be generated if not Array
        ErrNumb = Err.Number
        If ErrNumb <> 0 Then
            errDesc = Err.Description
        End If
    On Error GoTo 0
    
    Select Case ErrNumb
        Case 0
            If isDim Then
                On Error Resume Next
                    LB = LBound(TheArray, Dimension) 'just try to retrive Lbound
                    HasDimension = (Err.Number = 0)
                On Error GoTo 0
            End If
        Case 5
            Call Err.Raise(5, "HasDimension", "Invalid procedure call or argument. Argument is not an array!")
        Case Else
            Call Err.Raise(vbObjectError + 1, "HasDimension", _
                "This is unexpected error, caused when calling ""IsDimensioned"" function!" & vbCrLf & _
                "Original error: " & ErrNumb & vbCrLf & _
                "Description:" & errDesc)
    End Select
End Function
Function Mean(Arr() As Variant)
     Dim Sum As Single
     Dim i As Integer
     Dim k As Integer
     Sum = 0
     For i = LBound(Arr) To UBound(Arr)
         k = k + 1
         Sum = Sum + Arr(i)
     Next i
     Mean = Sum / k
     'MsgBox Mean
End Function
You can see a demonstration of it used in a query, here:
 
Upvote 0 Downvote
This is the one Im working with and testing. Would you please take a look and let me know what I'm doing wrong

Standard Deviations to be correct I need to skip, ignore, any fields that have either a Null, 0, or False

I'm sorry I'm so ignorant about VBA, I really appreciate you taking the time to help me with this and help me learn

 
Upvote 0 Downvote
You appear to be having a larger problem. Could be with your Access application. If I run your query it works fine. I also imported my my module and added this to the query:

Standard Deviations26M1: GetStDev([May_Pull_Thru],[June_Pull_Thru],[July_Pull_Thru],[Aug_Pull_Thru],[Sept_Pull_Thru],[Oct_Pull_Thru])

It also provides the correct result.
 
Upvote 0 Downvote
Majp you have been a huge help with all my access problems, and I thank you very much. I'm dont know what I'm doing wrong I keep getting this error

Run-time '9':

Subscript out of Range

IsDimensioned = ((UBound(TheArray) - LBound(TheArray)) >= 0)

 
Upvote 0 Downvote
As I said, I do not think you are doing anything wrong. The db you posted works fine with both my code and your original code. See this link

Just open this database and tell me if the query works. If this query does not work, then I think there is something wrong with your Access application. Because it appears to run fine on my computer and not on yours.
 
Upvote 0 Downvote
What version of Access do you have, and do you have the most current service pack loaded?
 
Upvote 0 Downvote
I still this error.

Run-time error ‘9’:

Subscript out of range

Then when I click on Debug a arrow is pointing this this highlighted part

IsDimensioned = ((UBound(TheArray) - LBound(TheArray)) >= 0)

This is what I have -> Microsoft Office Access 2003 (11.8321.8329) SP3
 
Upvote 0 Downvote
In VBE
Tools
Options
General (Tab)
set to "Break on unhandled errors"

yours is set to Break on all errors.
 
Upvote 0 Downvote
I'm sorry Majp but I'm not finding that message, is it possible that it’s located in a different place in my access 2003?
 
Upvote 0 Downvote
No. Or at least not if you have not deliberately customised the menu in the IDE. Are you sure that you are looking from the VBA IDE rather than the Access front page?
 
Upvote 0 Downvote
MajP, It worked!!!! Thank you so much for staying with my and helping me get this code to work. This is awesome. Thank you a 100 times, this really made my day. And I hope you know how much you’ve help me and everyone else that needs help in this form, you ROCK!!!.

Thank you, thank you, and thank you
TCB
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Moss100
  • Locked
  • Question
Filter vba problem
Replies
1
Views
487
Andrzejek
Andrzejek
Omarahmed22
  • Locked
  • Question
VBA Formating
Replies
1
Views
418
Andrzejek
Andrzejek
M
  • Locked
  • Question
display a calendar with appointments in body of html email with access vba
Replies
1
Views
2K
SoftwareRT
SoftwareRT
TheAceMan1
  • Locked
  • Question
Delete from listi n XL open tab with VBA
Replies
2
Views
332
TheAceMan1
TheAceMan1
DarkOne72
  • Locked
  • Question
Message Box Popup on certain days help !
2
Replies
23
Views
3K
Norman Sherlock
Norman Sherlock

Part and Inventory Search

Sponsor

Back
Top