Calculate standard deviation of the same text values in the same column
I am trying to write a macro in Excel to calculate the standard deviation of the same text in column A, taking values from column B and yielding results in column C:
I did it manually by putting an equation =STDEV.S(A2;A3;A4;A16)
for "aaa". But I need to do it automatically, because I am doing another calculation and procedures that are completed by macros. Here is my code:
Option Explicit
Sub Main()
CollectArray "A", "D"
DoSum "D", "E", "A", "B"
End Sub
' collect array from a specific column and print it to a new one without duplicates
' params:
' fromColumn - this is the column you need to remove duplicates from
' toColumn - this will reprint the array without the duplicates
Sub CollectArray(fromColumn As String, toColumn As String)
ReDim arr(0) As String
Dim i As Long
For i = 1 To Range(fromColumn & Rows.Count).End(xlUp).Row
arr(UBound(arr)) = Range(fromColumn & i)
ReDim Preserve arr(UBound(arr) + 1)
Next i
ReDim Preserve arr(UBound(arr) - 1)
RemoveDuplicate arr
Range(toColumn & "1:" & toColumn & Range(toColumn & Rows.Count).End(xlUp).Row).ClearContents
For i = LBound(arr) To UBound(arr)
Range(toColumn & i + 1) = arr(i)
Next i
End Sub
' sums up values from one column against the other column
' params:
' fromColumn - this is the column with string to match against
' toColumn - this is where the SUM will be printed to
' originalColumn - this is the original column including duplicate
' valueColumn - this is the column with the values to sum
Private Sub DoSum(fromColumn As String, toColumn As String, originalColumn As String, valueColumn As String)
Range(toColumn & "1:" & toColumn & Range(toColumn & Rows.Count).End(xlUp).Row).ClearContents
Dim i As Long
For i = 1 To Range(fromColumn & Rows.Count).End(xlUp).Row
Range(toColumn & i) = WorksheetFunction.SumIf(Range(originalColumn & ":" & originalColumn), Range(fromColumn & i), Range(valueColumn & ":" & valueColumn))
Next i
End Sub
Private Sub RemoveDuplicate(ByRef StringArray() As String)
Dim lowBound$, UpBound&, A&, B&, cur&, tempArray() As String
If (Not StringArray) = True Then Exit Sub
lowBound = LBound(StringArray): UpBound = UBound(StringArray)
ReDim tempArray(lowBound To UpBound)
cur = lowBound: tempArray(cur) = StringArray(lowBound)
For A = lowBound + 1 To UpBound
For B = lowBound To cur
If LenB(tempArray(B)) = LenB(StringArray(A)) Then
If InStrB(1, StringArray(A), tempArray(B), vbBinaryCompare) = 1 Then Exit For
End If
Next B
If B > cur Then cur = B
tempArray(cur) = StringArray(A)
Next A
ReDim Preserve tempArray(lowBound To cur): StringArray = tempArray
End Sub
It would be nice if someone could give me an idea or solution. The above code is for calculating the sum of the same text values. Is there a way to change my code to calculate the standard deviation?
source to share
Here is the VBA formula and route that gives you STDEV.S
for each set of items.
The image shows various ranges and results. My input is the same as yours, but I accidentally sorted it at one point so they don't line up.
Some notes
-
ARRAY
is the real answer.NON-ARRAY
shown later. - I have included a pivot table to test the accuracy of the method.
-
VBA
is the same answerARRAY
as calculated as UDF, which can be used elsewhere in your VBA.
The formula in a cell D3
is an array formula entered with CTRL + SHIFT + ENTER. This same formula is found in E3
no array input. Both are copied to the end of the data.
=STDEV.S(IF(B3=$B$3:$B$21,$C$3:$C$21))
Since you feel like you want the VBA version, you can use the same formula in VBA and just wrap it in Application.Evaluate
. This is pretty much how @Jeeped gets the answer by converting the range to values that meet the criteria.
The VBA code uses a Evaluate
formula string built from ranges given as input to process a string.
Public Function STDEV_S_IF(rng_criteria As Range, rng_criterion As Range, rng_values As Range) As Variant
Dim str_frm As String
'formula to reproduce
'=STDEV.S(IF(B3=$B$3:$B$21,$C$3:$C$21))
str_frm = "STDEV.S(IF(" & _
rng_criterion.Address & "=" & _
rng_criteria.Address & "," & _
rng_values.Address & "))"
'if you have more than one sheet, be sure it evalutes in the right context
'or add the sheet name to the references above
'single sheet works fine with just Application.Evaluate
'STDEV_S_IF = Application.Evaluate(str_frm)
STDEV_S_IF = Sheets("Sheet2").Evaluate(str_frm)
End Function
The formula in F3
is a VBA UDF of the same formula as above, it is entered as a normal formula (although entering as an array does not affect anything) and copied to the end.
=STDEV_S_IF($B$3:$B$21,B3,$C$3:$C$21)
It should be noted that it .Evaluate
correctly handles the shape of array formulas. You can compare this to a column NON-ARRAY
included in the output. I'm not sure how Excel knows how to relate to this. Previously, there was a fairly advanced conversion on how to Evaluate
handle array formulas and determine the output . This is relatively related to this conversation.
And for completeness, here's a test of the side of Sub
things. I am running this code in a module with an active sheet other than Sheet2
. This highlights the use case Sheets("Sheets2").Evaluate
for a multi-page book since my call is Range
technically wrong. Console output is enabled.
Sub test()
Debug.Print STDEV_S_IF(Range("B3:B21"), Range("B3"), Range("C3:C21"))
'correctly returns 206.301357242263
End Sub
source to share
I went in a different direction and provided the pseudo- STDEV.S.IF
used is the same as COUNTIF or AVERAGEIF function .
Function STDEV_S_IF(rAs As Range, rA As Range, rBs As Range)
Dim a As Long, sFRM As String
sFRM = "STDEV.s("
Set rBs = rBs(1).Resize(rAs.Rows.Count, 1)
For a = 1 To rAs.Rows.Count
If rAs(a).Value2 = rA.Value2 Then
sFRM = sFRM & rBs(a).Value2 & Chr(44)
End If
Next a
sFRM = Left(sFRM, Len(sFRM) - 1) & Chr(41)
STDEV_S_IF = Application.Evaluate(sFRM)
End Function
Syntax: STDEV_S_IF (<criteria range>, <criteria>, <stdev.s values>)
In your example, the formula in C2 would be,
=STDEV_S_IF(A$2:A$20, A2, B$2:B$20)
Fill in if necessary.
source to share