StDev Macro

zinah · Oct 15, 2019

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

zinah · Oct 21, 2019

I need the macro because I have several reports with 1000s of rows and I need to save this macro to my personal macros to use it whenever needed. Plus the macro makes it easier since the files I'm using have huge data, and what I need is to place values instead of formulas.
As for the formula, can you tell me exactly which formula you used to populate the result of Slice B "1.20".

Kenneth Hobson · Oct 21, 2019

Code:

Sub Main()
  Dim c As Range, r As Range
  Set r = Range("A2", Cells(Rows.Count, "A").End(xlUp))
  For Each c In r
    'Weighted Average/Mean
    c.Offset(, 2) = wAvg(Array(6, 5, 4, 3, 2, 1), c.Offset(, 7).Resize(, 6))
    c.Offset(, 2).Resize(, 2).NumberFormat = "#.00"
    c.Offset(, 3) = wSD(Array(6, 5, 4, 3, 2, 1), c.Offset(, 7).Resize(, 6))
  Next c
End Sub


Function wAvg(xi, wi) As Double
  With WorksheetFunction
    wAvg = .sumProduct(xi, wi) / .Sum(wi)
  End With
End Function


'https://www.itl.nist.gov/div898/software/dataplot/refman2/ch2/weightsd.pdf
Function wSD(xi, wi) As Double
  Dim s As Double, n As Double
  With WorksheetFunction
    s = .Sum(wi)
    n = .Count(xi)
    '' =SQRT(SUMPRODUCT(wi*(xi-WgtAvg)^2)/SUM(wi) * N/(N-1))
    wSD = (spSD(xi, wi) / s * n / (n - 1)) ^ 0.5
  End With
End Function


Function spSD(xi, wi) As Double
  Dim i As Integer, j As Integer, d As Double, w As Double

  w = wAvg(xi, wi)
  Select Case True
    Case TypeName(xi) = "Range" And TypeName(wi) = "Range"
      For i = 1 To xi.Count
        d = d + wi(i) * (xi(i) - w) ^ 2
      Next i
    Case TypeName(xi) = "Range" And TypeName(wi) = "Variant()"
      j = 0
      If LBound(wi) = 0 Then j = -1
      For i = 1 To xi.Count
        j = j + 1
        d = d + wi(j) * (xi(i) - w) ^ 2
      Next i
    Case TypeName(xi) = "Variant()" And TypeName(wi) = "Range"
      j = 0
      If LBound(xi) = 0 Then j = -1
      For i = 1 To wi.Count
        j = j + 1
        d = d + wi(i) * (xi(j) - w) ^ 2
      Next i
    Case TypeName(xi) = "Variant()" And TypeName(wi) = "Variant"
      'Assume both wi and xi as same Base.
      For i = LBound(wi) To UBound(wi)
        j = j + 1
        d = d + wi(i) * (xi(i) - w) ^ 2
      Next i
    Case Else
  End Select
  
  spSD = d
End Function

zinah · Oct 22, 2019

Thank you soooo much Kenneth! I really appreciate your time and help! The macro worked fine, however, I got error message "Overflow" whenever there's empty rows, is there any work around for such situation as I have so many empty rows "since it's survey and we expect not all the population answer". Below is an example table that can help to explain:

Slice	Count of Responses	Average Score	Std Dev	Favorable Percent	Neutral Percent	Unfavorable Percent	6. Strongly Agree	5. Agree	4. Somewhat Agree	3. Somewhat Disagree	2. Disagree	1. Strongly Disagree
B	12	4.43	1.20	54.79%	37.72%	7.49%	84	282	198	54	40	10
C	7	4.37	1.38	56.54%	32.37%	11.09%	72	183	100	46	37	13
D	2
E	3
F	2
G	4
H	1
I	1
J	16	4.14		44.35%	42.46%	13.19%	124	276	259	124	85	34
K	11	4.42		52.54%	36.23%	11.23%	204	147	135	107	56	19
L	12	4.97		76.68%	18.38%	4.94%	263	296	103	31	21	15
M	7	3.82		35.19%	44.54%	20.27%	31	127	151	49	50	41
N	18	3.60		33.90%	36.78%	29.32%	65	276	260	110	188	107
O	49	4.38		56.12%	32.30%	11.58%	519	1017	639	245	186	131

Kenneth Hobson · Oct 22, 2019

One method, use Application.CountA to count the 6 cell range. If 0, Goto the next i...

zinah · Oct 22, 2019

Where should I put this code in macro?

Code:

[COLOR=#333333]Sub Main()[/COLOR]
[COLOR=#333333]Dim c As Range, r As Range[/COLOR]
[COLOR=#333333]Set r = Range("A2", Cells(Rows.Count, "A").End(xlUp))[/COLOR]
[COLOR=#333333]For Each c In r[/COLOR]
[COLOR=#333333]'Weighted Average/Mean[/COLOR]
[COLOR=#333333]c.Offset(, 2) = wAvg(Array(6, 5, 4, 3, 2, 1), c.Offset(, 7).Resize(, 6))[/COLOR]
[COLOR=#333333]c.Offset(, 2).Resize(, 2).NumberFormat = "#.00"[/COLOR]
[COLOR=#333333]c.Offset(, 3) = wSD(Array(6, 5, 4, 3, 2, 1), c.Offset(, 7).Resize(, 6))[/COLOR]
[COLOR=#333333]Next c[/COLOR]
[COLOR=#333333]End Sub[/COLOR]


[COLOR=#333333]Function wAvg(xi, wi) As Double[/COLOR]
[COLOR=#333333]With WorksheetFunction[/COLOR]
[COLOR=#333333]wAvg = .sumProduct(xi, wi) / .Sum(wi)[/COLOR]
[COLOR=#333333]End With[/COLOR]
[COLOR=#333333]End Function[/COLOR]


[COLOR=#333333]'https://www.itl.nist.gov/div898/software/dataplot/refman2/ch2/weightsd.pdf[/COLOR]
[COLOR=#333333]Function wSD(xi, wi) As Double[/COLOR]
[COLOR=#333333]Dim s As Double, n As Double[/COLOR]
[COLOR=#333333]With WorksheetFunction[/COLOR]
[COLOR=#333333]s = .Sum(wi)[/COLOR]
[COLOR=#333333]n = .Count(xi)[/COLOR]
[COLOR=#333333]'' =SQRT(SUMPRODUCT(wi*(xi-WgtAvg)^2)/SUM(wi) * N/(N-1))[/COLOR]
[COLOR=#333333]wSD = (spSD(xi, wi) / s * n / (n - 1)) ^ 0.5[/COLOR]
[COLOR=#333333]End With[/COLOR]
[COLOR=#333333]End Function[/COLOR]


[COLOR=#333333]Function spSD(xi, wi) As Double[/COLOR]
[COLOR=#333333]Dim i As Integer, j As Integer, d As Double, w As Double[/COLOR]

[COLOR=#333333]w = wAvg(xi, wi)[/COLOR]
[COLOR=#333333]Select Case True[/COLOR]
[COLOR=#333333]Case TypeName(xi) = "Range" And TypeName(wi) = "Range"[/COLOR]
[COLOR=#333333]For i = 1 To xi.Count[/COLOR]
[COLOR=#333333]d = d + wi(i) * (xi(i) - w) ^ 2[/COLOR]
[COLOR=#333333]Next i[/COLOR]
[COLOR=#333333]Case TypeName(xi) = "Range" And TypeName(wi) = "Variant()"[/COLOR]
[COLOR=#333333]j = 0[/COLOR]
[COLOR=#333333]If LBound(wi) = 0 Then j = -1[/COLOR]
[COLOR=#333333]For i = 1 To xi.Count[/COLOR]
[COLOR=#333333]j = j + 1[/COLOR]
[COLOR=#333333]d = d + wi(j) * (xi(i) - w) ^ 2[/COLOR]
[COLOR=#333333]Next i[/COLOR]
[COLOR=#333333]Case TypeName(xi) = "Variant()" And TypeName(wi) = "Range"[/COLOR]
[COLOR=#333333]j = 0[/COLOR]
[COLOR=#333333]If LBound(xi) = 0 Then j = -1[/COLOR]
[COLOR=#333333]For i = 1 To wi.Count[/COLOR]
[COLOR=#333333]j = j + 1[/COLOR]
[COLOR=#333333]d = d + wi(i) * (xi(j) - w) ^ 2[/COLOR]
[COLOR=#333333]Next i[/COLOR]
[COLOR=#333333]Case TypeName(xi) = "Variant()" And TypeName(wi) = "Variant"[/COLOR]
[COLOR=#333333]'Assume both wi and xi as same Base.[/COLOR]
[COLOR=#333333]For i = LBound(wi) To UBound(wi)[/COLOR]
[COLOR=#333333]j = j + 1[/COLOR]
[COLOR=#333333]d = d + wi(i) * (xi(i) - w) ^ 2[/COLOR]
[COLOR=#333333]Next i[/COLOR]
[COLOR=#333333]Case Else[/COLOR]
[COLOR=#333333]End Select[/COLOR]

[COLOR=#333333]spSD = d[/COLOR]
[COLOR=#333333]End Function[/COLOR]

Kenneth Hobson · Oct 22, 2019

I have not tested it but maybe:

Code:

Sub Main()
  Dim c As Range, r As Range
  Set r = Range("A2", Cells(Rows.Count, "A").End(xlUp))
  For Each c In r
[COLOR="#FF0000"]    If Application.CountA(c.Offset(, 7).Resize(, 6)) = 0 Then GoTo NextC[/COLOR]
    'Weighted Average/Mean
    c.Offset(, 2) = wAvg(Array(6, 5, 4, 3, 2, 1), c.Offset(, 7).Resize(, 6))
    c.Offset(, 2).Resize(, 2).NumberFormat = "#.00"
    c.Offset(, 3) = wSD(Array(6, 5, 4, 3, 2, 1), c.Offset(, 7).Resize(, 6))
[COLOR="#FF0000"]NextC:[/COLOR]
  Next c
End Sub

zinah · Oct 22, 2019

I think THANK YOU won't be enough Kenneth! I really really appreciate your help, the macro worked perfectly great! thanks a million!

StDev Macro

zinah

Active Member

zinah

Active Member

Excel Facts

Kenneth Hobson

Well-known Member

zinah

Active Member

Kenneth Hobson

Well-known Member

zinah

Active Member

Kenneth Hobson

Well-known Member

zinah

Active Member

Similar threads

Forum statistics

Share this page

StDev Macro

Active Member

Active Member

Excel Facts

Well-known Member

Active Member

Well-known Member

Active Member

Well-known Member

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock