StDev Macro

zinah

Active Member
Joined
Nov 28, 2018
Messages
368
Office Version
  1. 365
Platform
  1. Windows
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
 
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".
 
Upvote 0

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
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
 
Upvote 0
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:

[TABLE="width: 832"]
<colgroup><col width="64" span="13" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl65, width: 64"]Slice[/TD]
[TD="class: xl65, width: 64"]Count of Responses[/TD]
[TD="class: xl65, width: 64"]Average Score[/TD]
[TD="class: xl67, width: 64"]Std Dev[/TD]
[TD="class: xl66, width: 64"]Favorable Percent[/TD]
[TD="class: xl65, width: 64"]Neutral Percent[/TD]
[TD="class: xl65, width: 64"]Unfavorable Percent[/TD]
[TD="class: xl65, width: 64"]6. Strongly Agree[/TD]
[TD="class: xl65, width: 64"]5. Agree[/TD]
[TD="class: xl65, width: 64"]4. Somewhat Agree[/TD]
[TD="class: xl65, width: 64"]3. Somewhat Disagree[/TD]
[TD="class: xl65, width: 64"]2. Disagree[/TD]
[TD="class: xl65, width: 64"]1. Strongly Disagree[/TD]
[/TR]
[TR]
[TD="class: xl68"]B[/TD]
[TD="class: xl68, align: right"]12[/TD]
[TD="class: xl72, align: right"]4.43[/TD]
[TD="class: xl73, align: right"]1.20[/TD]
[TD="class: xl71, align: right"]54.79%[/TD]
[TD="class: xl71, align: right"]37.72%[/TD]
[TD="class: xl71, align: right"]7.49%[/TD]
[TD="class: xl68, align: right"]84[/TD]
[TD="class: xl68, align: right"]282[/TD]
[TD="class: xl68, align: right"]198[/TD]
[TD="class: xl68, align: right"]54[/TD]
[TD="class: xl68, align: right"]40[/TD]
[TD="class: xl68, align: right"]10[/TD]
[/TR]
[TR]
[TD="class: xl68"]C[/TD]
[TD="class: xl68, align: right"]7[/TD]
[TD="class: xl72, align: right"]4.37[/TD]
[TD="class: xl73, align: right"]1.38[/TD]
[TD="class: xl71, align: right"]56.54%[/TD]
[TD="class: xl71, align: right"]32.37%[/TD]
[TD="class: xl71, align: right"]11.09%[/TD]
[TD="class: xl68, align: right"]72[/TD]
[TD="class: xl68, align: right"]183[/TD]
[TD="class: xl68, align: right"]100[/TD]
[TD="class: xl68, align: right"]46[/TD]
[TD="class: xl68, align: right"]37[/TD]
[TD="class: xl68, align: right"]13[/TD]
[/TR]
[TR]
[TD="class: xl68"]D[/TD]
[TD="class: xl68, align: right"]2[/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[/TR]
[TR]
[TD="class: xl68"]E[/TD]
[TD="class: xl68, align: right"]3[/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[/TR]
[TR]
[TD="class: xl68"]F[/TD]
[TD="class: xl68, align: right"]2[/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[/TR]
[TR]
[TD="class: xl68"]G[/TD]
[TD="class: xl68, align: right"]4[/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[/TR]
[TR]
[TD="class: xl68"]H[/TD]
[TD="class: xl68, align: right"]1[/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[/TR]
[TR]
[TD="class: xl68"]I[/TD]
[TD="class: xl68, align: right"]1[/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[TD="class: xl68"][/TD]
[/TR]
[TR]
[TD="class: xl68"]J[/TD]
[TD="class: xl68, align: right"]16[/TD]
[TD="class: xl69, align: right"]4.14[/TD]
[TD="class: xl70"][/TD]
[TD="class: xl71, align: right"]44.35%[/TD]
[TD="class: xl71, align: right"]42.46%[/TD]
[TD="class: xl71, align: right"]13.19%[/TD]
[TD="class: xl68, align: right"]124[/TD]
[TD="class: xl68, align: right"]276[/TD]
[TD="class: xl68, align: right"]259[/TD]
[TD="class: xl68, align: right"]124[/TD]
[TD="class: xl68, align: right"]85[/TD]
[TD="class: xl68, align: right"]34[/TD]
[/TR]
[TR]
[TD="class: xl68"]K[/TD]
[TD="class: xl68, align: right"]11[/TD]
[TD="class: xl69, align: right"]4.42[/TD]
[TD="class: xl70"][/TD]
[TD="class: xl71, align: right"]52.54%[/TD]
[TD="class: xl71, align: right"]36.23%[/TD]
[TD="class: xl71, align: right"]11.23%[/TD]
[TD="class: xl68, align: right"]204[/TD]
[TD="class: xl68, align: right"]147[/TD]
[TD="class: xl68, align: right"]135[/TD]
[TD="class: xl68, align: right"]107[/TD]
[TD="class: xl68, align: right"]56[/TD]
[TD="class: xl68, align: right"]19[/TD]
[/TR]
[TR]
[TD="class: xl68"]L[/TD]
[TD="class: xl68, align: right"]12[/TD]
[TD="class: xl69, align: right"]4.97[/TD]
[TD="class: xl70"][/TD]
[TD="class: xl71, align: right"]76.68%[/TD]
[TD="class: xl71, align: right"]18.38%[/TD]
[TD="class: xl71, align: right"]4.94%[/TD]
[TD="class: xl68, align: right"]263[/TD]
[TD="class: xl68, align: right"]296[/TD]
[TD="class: xl68, align: right"]103[/TD]
[TD="class: xl68, align: right"]31[/TD]
[TD="class: xl68, align: right"]21[/TD]
[TD="class: xl68, align: right"]15[/TD]
[/TR]
[TR]
[TD="class: xl68"]M[/TD]
[TD="class: xl68, align: right"]7[/TD]
[TD="class: xl69, align: right"]3.82[/TD]
[TD="class: xl70"][/TD]
[TD="class: xl71, align: right"]35.19%[/TD]
[TD="class: xl71, align: right"]44.54%[/TD]
[TD="class: xl71, align: right"]20.27%[/TD]
[TD="class: xl68, align: right"]31[/TD]
[TD="class: xl68, align: right"]127[/TD]
[TD="class: xl68, align: right"]151[/TD]
[TD="class: xl68, align: right"]49[/TD]
[TD="class: xl68, align: right"]50[/TD]
[TD="class: xl68, align: right"]41[/TD]
[/TR]
[TR]
[TD="class: xl68"]N[/TD]
[TD="class: xl68, align: right"]18[/TD]
[TD="class: xl69, align: right"]3.60[/TD]
[TD="class: xl70"][/TD]
[TD="class: xl71, align: right"]33.90%[/TD]
[TD="class: xl71, align: right"]36.78%[/TD]
[TD="class: xl71, align: right"]29.32%[/TD]
[TD="class: xl68, align: right"]65[/TD]
[TD="class: xl68, align: right"]276[/TD]
[TD="class: xl68, align: right"]260[/TD]
[TD="class: xl68, align: right"]110[/TD]
[TD="class: xl68, align: right"]188[/TD]
[TD="class: xl68, align: right"]107[/TD]
[/TR]
[TR]
[TD="class: xl68"]O[/TD]
[TD="class: xl68, align: right"]49[/TD]
[TD="class: xl69, align: right"]4.38[/TD]
[TD="class: xl70"][/TD]
[TD="class: xl71, align: right"]56.12%[/TD]
[TD="class: xl71, align: right"]32.30%[/TD]
[TD="class: xl71, align: right"]11.58%[/TD]
[TD="class: xl68, align: right"]519[/TD]
[TD="class: xl68, align: right"]1017[/TD]
[TD="class: xl68, align: right"]639[/TD]
[TD="class: xl68, align: right"]245[/TD]
[TD="class: xl68, align: right"]186[/TD]
[TD="class: xl68, align: right"]131[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
One method, use Application.CountA to count the 6 cell range. If 0, Goto the next i...
 
Upvote 0
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]



 
Last edited:
Upvote 0
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
 
Upvote 0
I think THANK YOU won't be enough Kenneth! I really really appreciate your help, the macro worked perfectly great! thanks a million!
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top