StDev Macro

zinah

Board Regular
Hi,

I have below macro that calculate StDev and it was working perfectly fine but I got error "unable to get the StDev property of the worksheetfunction class" whenever the I have empty cells. How can I fix this and make it ignore the empty cells and move on with other cells that have data?

Code:
Sub NV_stdev()Dim aSht As Worksheet
    Set aSht = ActiveSheet
Dim firstC, firstR, lastC, lastR As Long
    firstC = 1
    firstR = 1
    lastC = aSht.Cells(firstR, aSht.Columns.Count).End(xlToLeft).Column
    lastR = aSht.Cells(aSht.Rows.Count, firstC).End(xlUp).Row


Dim sa, a, wa, wd, d, sd, mu, n, sigma As String
    sa = "6. Strongly Agree"
    a = "5. Agree"
    wa = "4. Somewhat Agree"
    wd = "3. Somewhat Disagree"
    d = "2. Disagree"
    sd = "1. Strongly Disagree"
    mu = "Average Score"
    n = "Count of Responses"
    sigma = "Std Dev"


Dim saR, aR, waR, wdR, dR, sdR, muR, nR, sigmaR As Range
    Set saR = Cells(1, Application.WorksheetFunction.Match(sa, ActiveSheet.[1:1], 0))
    Set aR = Cells(1, Application.WorksheetFunction.Match(a, ActiveSheet.[1:1], 0))
    Set waR = Cells(1, Application.WorksheetFunction.Match(wa, ActiveSheet.[1:1], 0))
    Set wdR = Cells(1, Application.WorksheetFunction.Match(wd, ActiveSheet.[1:1], 0))
    Set dR = Cells(1, Application.WorksheetFunction.Match(d, ActiveSheet.[1:1], 0))
    Set sdR = Cells(1, Application.WorksheetFunction.Match(sd, ActiveSheet.[1:1], 0))
    Set muR = Cells(1, Application.WorksheetFunction.Match(mu, ActiveSheet.[1:1], 0))
    Set nR = Cells(1, Application.WorksheetFunction.Match(n, ActiveSheet.[1:1], 0))
    Set sigmaR = Cells(1, Application.WorksheetFunction.Match(sigma, ActiveSheet.[1:1], 0))




Dim saN, aN, waN, wdN, dN, sdN As Integer
    saN = Val(Left(saR.Value, 1))
    aN = Val(Left(aR.Value, 1))
    waN = Val(Left(waR.Value, 1))
    wdN = Val(Left(wdR.Value, 1))
    dN = Val(Left(dR.Value, 1))
    sdN = Val(Left(sdR.Value, 1))




Dim responses As Variant, i As Long
For Each itm In Range(Cells(firstR + 1, sigmaR.Column), Cells(lastR, sigmaR.Column))
    i = 1  '<-- initiate array element index
If Cells(itm.Row, nR.Column).Value <> "" And Cells(itm.Row, nR.Column).Value > 0 Then
ReDim responses(1 To Cells(itm.Row, nR.Column).Value) As Variant
    For x = 1 To Cells(itm.Row, saR.Column).Value
        responses(i) = saN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, aR.Column).Value
        responses(i) = aN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, waR.Column).Value
        responses(i) = waN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, wdR.Column).Value
        responses(i) = wdN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, dR.Column).Value
        responses(i) = dN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, sdR.Column).Value
        responses(i) = sdN
        i = i + 1
    Next x


With Cells(itm.Row, sigmaR.Column)
    .Value = Application.WorksheetFunction.StDev(responses)
    .Font.Color = RGB(0, 56, 70)
    .Font.Name = "Calibri"
    .Font.Size = 8
    .NumberFormat = "0.00_#_#;;"
End With
End If


Next itm




End Sub
 

baitmaster

Well-known Member
If the code Application.WorksheetFunction.StDev(responses) doesn't work because responses is empty then you could test responses before running this calculation. As it's an array you can test it's UBOUND to see if it's got zero dimension. Try adding something like
Code:
if not ubound([COLOR=#333333]responses) = 0 then [/COLOR]
As you're using i to monitor where items get passed to the array you could also use this, but it's not quite straightforward because of how you're using it. Personally I would set it to 0 to start with, then add 1 only if required - I can then test if it's zero or not. You may have to test if it's >1. Works exactly the same but the logic can get confusing if you're not careful...

If the problem is that responses is populated but with only a zero value then you could test for that instead
 

zinah

Board Regular
Hi,

Thank you for your help! How can I add this code? and yes the problem is with the cells that have empty responses as when I removed the rows that have empty cells, the macro worked perfectly fine. Is there a way to fix that?
 

baitmaster

Well-known Member
You could try something like
Code:
With Cells(itm.Row, sigmaR.Column)
    [COLOR=#333333]if ubound([/COLOR][COLOR=#333333][COLOR=#333333]responses) = 0 then [/COLOR][/COLOR]
        .Value = 0
    else
        .value = Application.WorksheetFunction.StDev(responses)
    end if
    .Font.Color = RGB(0, 56, 70)
    .Font.Name = "Calibri"
    .Font.Size = 8
    .NumberFormat = "0.00_#_#;;"
End With
End If
 

zinah

Board Regular
Same error message "unable to get the StDev property of the worksheetfunction class" and it highlight below code:

Code:
      .Value = Application.WorksheetFunction.StDev(responses)
I have blank cells not "0"
 
Last edited:

baitmaster

Well-known Member
OK, I take it you're quite unfamiliar with VBA, so let's look at a few things we can do to find the problem and fix it

The problem is because the code is trying to run an impossible calculation on the array variable "responses". We can either seek to understand why this is impossible, then check for those conditions and bypass the calculation when found, or we can stick a generic error handler in there that will react when the problem occurs

My first guess was that responses was an empty array and hence I was testing it to see if the size was zero, but this apparently is not the case. Perhaps instead there are lots of values but all are zero and that causes a failure..? It's possible to view the array when the code breaks, and then work out why it doesn't work. To do this, you need to show the Locals window (VB > View > Locals Window) and then run your code.

When the code breaks you can enter DEBUG mode (the problematic code line is highlighted in yellow), then this window contains details of all currently-active variables. You're looking for the responses variable, and you should be able to investigate it and see all values within it. I'm interested in what you can learn from this window, and you'll benefit from understanding it better


Generic error handler:
Another approach is to set up an error handler. The following tells the code to ignore the problem (but this doesn't always work), so we can assign a default value to a variable then only change it if a better value is found. I don't like this approach because it can mask other problems, but it may work OK for you
Code:
dim dblValue as double
on error resume next    ' ignore any errors encountered
    dblValue = 0    ' resets it every loop if you are looping
    dblValue = Application.WorksheetFunction.StDev(responses)
on error goto 0    ' switch error handling off again

With Cells(itm.Row, sigmaR.Column)
    .Value = dblvalue
    .Font.Color = RGB(0, 56, 70)
    .Font.Name = "Calibri"
    .Font.Size = 8
    .NumberFormat = "0.00_#_#;;"
End With
 

zinah

Board Regular
Hi @baitmaster !

Thank you for your time and explaining the macro, sorry for the late respond but I didn't get the notification of your reply. Yes, I'm too new to VBA world but trying my best to learn. Let me tell you what I have and maybe you could help. I have a survey that is based on 6 rating

6. Strongly Agree5. Agree4. Somewhat Agree3. Somewhat Disagree2. Disagree1. Strongly Disagree



<tbody>
</tbody>
What I want is to calculate Std Dev for each row. Below is a sample data along with calculated Std Dev. I want to update my macro to produce the same results in column Std Dev

SliceCount of ResponsesAverage ScoreStd DevFavorable PercentNeutral PercentUnfavorable Percent6. Strongly Agree5. Agree4. Somewhat Agree3. Somewhat Disagree2. Disagree1. Strongly Disagree
B124.431.09 54.79%37.72%7.49%84282198544010
C74.371.26 56.54%32.37%11.09%72183100463713
D164.141.30 44.35%42.46%13.19%1242762591248534
E114.421.42 52.54%36.23%11.23%2041471351075619
F124.971.12 76.68%18.38%4.94%263296103312115
G73.821.38 35.19%44.54%20.27%31127151495041
H183.601.48 33.90%36.78%29.32%65276260110188107
I494.381.33 56.12%32.30%11.58%5191017639245186131


<colgroup><col width="64" span="13" style="width:48pt"> </colgroup><tbody>
</tbody>


Code:
Sub Stdev_test()    Set aSht = ActiveSheet
Dim firstC, firstR, lastC, lastR As Long
    firstC = 1
    firstR = 1
    lastC = aSht.Cells(firstR, aSht.Columns.Count).End(xlToLeft).Column
    lastR = aSht.Cells(aSht.Rows.Count, firstC).End(xlUp).Row




Dim sa, a, wa, wd, d, sd, mu, n, sigma As String
    sa = "6. Strongly Agree"
    a = "5. Agree"
    wa = "4. Somewhat Agree"
    wd = "3. Somewhat Disagree"
    d = "2. Disagree"
    sd = "1. Strongly Disagree"
    mu = "Average Score"
    n = "Count of Responses"
    sigma = "Std Dev"




Dim saR, aR, waR, wdR, dR, sdR, muR, nR, sigmaR As Range
    Set saR = Cells(1, Application.WorksheetFunction.Match(sa, ActiveSheet.[1:1], 0))
    Set aR = Cells(1, Application.WorksheetFunction.Match(a, ActiveSheet.[1:1], 0))
    Set waR = Cells(1, Application.WorksheetFunction.Match(wa, ActiveSheet.[1:1], 0))
    Set wdR = Cells(1, Application.WorksheetFunction.Match(wd, ActiveSheet.[1:1], 0))
    Set dR = Cells(1, Application.WorksheetFunction.Match(d, ActiveSheet.[1:1], 0))
    Set sdR = Cells(1, Application.WorksheetFunction.Match(sd, ActiveSheet.[1:1], 0))
    Set muR = Cells(1, Application.WorksheetFunction.Match(mu, ActiveSheet.[1:1], 0))
    Set nR = Cells(1, Application.WorksheetFunction.Match(n, ActiveSheet.[1:1], 0))
    Set sigmaR = Cells(1, Application.WorksheetFunction.Match(sigma, ActiveSheet.[1:1], 0))








Dim saN, aN, waN, wdN, dN, sdN As Integer
    saN = Val(Left(saR.Value, 1))
    aN = Val(Left(aR.Value, 1))
    waN = Val(Left(waR.Value, 1))
    wdN = Val(Left(wdR.Value, 1))
    dN = Val(Left(dR.Value, 1))
    sdN = Val(Left(sdR.Value, 1))
    


Dim responses As Variant, i As Long
For Each itm In Range(Cells(firstR + 1, sigmaR.Column), Cells(lastR, sigmaR.Column))
    i = 1  '<-- initiate array element index
If Cells(itm.Row, nR.Column).Value <> "" And Cells(itm.Row, nR.Column).Value > 0 Then


ReDim responses(1 To Cells(itm.Row, nR.Column).Value) As Variant
    For x = 1 To Cells(itm.Row, saR.Column).Value
        responses(i) = saN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, aR.Column).Value
        responses(i) = aN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, waR.Column).Value
        responses(i) = waN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, wdR.Column).Value
        responses(i) = wdN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, dR.Column).Value
        responses(i) = dN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, sdR.Column).Value
        responses(i) = sdN
        i = i + 1
    Next x




With Cells(itm.Row, sigmaR.Column)
    .Value = Application.WorksheetFunction.StDev(responses)
    .Font.Color = RGB(0, 56, 70)
    .Font.Name = "Calibri"
    .Font.Size = 8
    .NumberFormat = "0.00_#_#;;"
End With
End If




Next itm








End Sub
 

zinah

Board Regular
Yes, I’m using weighted average. Maybe the results I provided are not correct, could you help me with updating my macro with the right formula/ codes?
 

Kenneth Hobson

Well-known Member
Why do you need a macro? Formulas can do it.

I did make macro UDFs to do the weighted average and weighted sample standard deviation. The only advantage I guess is that they are easier to use as a UDF as shorter "formulas". Of course they can also just insert the values rather than formulas.

It just depends on what solution path you want to use.
 

Some videos you may like

This Week's Hot Topics

Top