Significance Testing Macro

[V_F]

I'm currently working on a version of a previous significance testing macro that I had developed. Most of it works with the exception of some looping. The current version that is attached goes through each row and calculates proportions and runs 2 sample proportion z tests for each row and that all works, but what I'm wanting it to do is if the test results in a "No", as in it's not significant, I want it to output in the cell to the right (i, 9) the alpha level required to achieve significance. The macro allows the user to choose whichever alpha level they want, but for info purposes, it's good to see how close the alpha level is to significance if none is achieved.
I believe the issue is stemming from the nested loop (referring the 'j') since my previous macro worked that didn't include that.
I'm hoping for some advice as to what is going on with this. Any help is appreciated.

[SamT]

Private Sub ComputeButton_Click()
Dim A As String, B As String, C As String, D As String, E As String, Num1 As Range, _
Denom1 As Range, Num2 As Range, Denom2 As Range, Output As Range, Lift As Double, _
StndError As Double, TestStat As Double, pValue As Double, Incidence1 As Double, _
Incidence2 As Double, Index As Double, Alpha As Variant, Confidence As Double
Dim w, x, y, z

'TextBoxes
A = Sample1Numerator.Value
B = Sample1Denominator.Value
C = Sample2Numerator.Value
D = Sample2Denominator.Value
E = OutputRange.Value

w = Range(A).Cells.Count
x = Range(B).Cells.Count
y = Range(C).Cells.Count
z = Range(D).Cells.Count
If AlphaBox.Value = "" Then Alpha = 0.05 Else Alpha = AlphaBox.Value
Confidence = Application.WorksheetFunction.Product(100, (1 - Alpha))
For i = 1 To w
If Range(A)(i) <> "" Then
Set Num1 = Range(A)(i)
Set Denom1 = Range(B)(i)
Set Num2 = Range(C)(i)
Set Denom2 = Range(D)(i)
Set Output = Range(E)(1) 'Does not increment
Incidence1 = Num1 / Denom1
Incidence2 = Num2 / Denom2
If Incidence2 <> 0 Then Index = (Incidence1 / Incidence2) * 100 Else Index = 0
Lift = (Incidence1 - Incidence2) * 100
StndError = Sqr(Application.WorksheetFunction.Sum(Application.WorksheetFunction.Product (Incidence2, _
((1 - Incidence2) / Application.WorksheetFunction.Sum(Denom2))), _
Application.WorksheetFunction.Product(Incidence1, _
((1 - Incidence1) / Application.WorksheetFunction.Sum(Denom1)))))

TestStat = (Incidence1 - Incidence2) / StndError

If Lift > 0 Then
pValue = 1 - (WorksheetFunction.Norm_S_Dist(Arg1:=TestStat, Arg2:=True))
Else
pValue = (WorksheetFunction.Norm_S_Dist(Arg1:=TestStat, Arg2:=True))
Output.Offset(i, 0).NumberFormat = "0.0%"
Output.Offset(i, 1).NumberFormat = "0.0%"
Output.Offset(i, 0) = Incidence1
Output.Offset(i, 1) = Incidence2
Output.Offset(i, 3) = Index
Output.Offset(i, 4) = Lift
Output.Offset(i, 5) = StndError
Output.Offset(i, 6) = TestStat
Output.Offset(i, 7) = pValue
If pValue < 0.05 Then Output.Offset(i, 8) = "Yes" Else Output.Offset(i, 8) = "No"
If Output.Offset(i, 8) = "Yes" Then Output.Offset(i, 8).Interior.ColorIndex = 35
If Output.Offset(i, 8) = "No" Then Output.Offset(i, 8).Interior.ColorIndex = 38
If Output.Offset(i, 8) = "No" Then
Do
j = j + 0.01
Loop Until j > pValue
Output.Offset(i, 9).NumberFormat = "0%"
Output.Offset(i, 9) = j
End If
If Output.Offset(i, 8) = "No" Then Output.Offset(0, 9) = "Alpha Level Significant At"
End If
Next i

For i = 1 To x
If Range(B)(i) <> "" Then
Set Num1 = Range(A)(i)
Set Denom1 = Range(B)(i)
Set Num2 = Range(C)(i)
Set Denom2 = Range(D)(i)
Set Output = Range(E)(1) 'Does not increment
Incidence1 = Num1 / Denom1
Incidence2 = Num2 / Denom2
If Incidence2 <> 0 Then Index = (Incidence1 / Incidence2) * 100 Else Index = 0
Lift = (Incidence1 - Incidence2) * 100
StndError = Sqr(Application.WorksheetFunction.Sum(Application.WorksheetFunction.Product (Incidence2, _
((1 - Incidence2) / Application.WorksheetFunction.Sum(Denom2))), _
Application.WorksheetFunction.Product(Incidence1, _
((1 - Incidence1) / Application.WorksheetFunction.Sum(Denom1)))))
TestStat = (Incidence1 - Incidence2) / StndError

If Lift > 0 Then
pValue = 1 - (WorksheetFunction.Norm_S_Dist(Arg1:=TestStat, Arg2:=True))
Else
pValue = (WorksheetFunction.Norm_S_Dist(Arg1:=TestStat, Arg2:=True))
Output.Offset(i, 0).NumberFormat = "0.0%"
Output.Offset(i, 1).NumberFormat = "0.0%"
Output.Offset(i, 0) = Incidence1
Output.Offset(i, 1) = Incidence2
Output.Offset(i, 3) = Index
Output.Offset(i, 4) = Lift
Output.Offset(i, 5) = StndError
Output.Offset(i, 6) = TestStat
Output.Offset(i, 7) = pValue
If pValue < 0.05 Then Output.Offset(i, 8) = "Yes" Else Output.Offset(i, 8) = "No"
If Output.Offset(i, 8) = "Yes" Then Output.Offset(i, 8).Interior.ColorIndex = 35
If Output.Offset(i, 8) = "No" Then Output.Offset(i, 8).Interior.ColorIndex = 38
If Output.Offset(i, 8) = "No" Then
Do
j = j + 0.01
Loop Until j > pValue
Output.Offset(i, 9).NumberFormat = "0%"
Output.Offset(i, 9) = j
End If
If Output.Offset(i, 8) = "No" Then Output.Offset(0, 9) = "Alpha Level Significant At"
End If
Next i

For i = 1 To y
If Range(C)(i) <> "" Then
Set Num1 = Range(A)(i)
Set Denom1 = Range(B)(i)
Set Num2 = Range(C)(i)
Set Denom2 = Range(D)(i)
Set Output = Range(E)(1) 'Does not increment
Incidence1 = Num1 / Denom1
Incidence2 = Num2 / Denom2
If Incidence2 <> 0 Then Index = (Incidence1 / Incidence2) * 100 Else Index = 0
Lift = (Incidence1 - Incidence2) * 100
StndError = Sqr(Application.WorksheetFunction.Sum(Application.WorksheetFunction.Product (Incidence2, ((1 - Incidence2) / Application.WorksheetFunction.Sum(Denom2))), Application.WorksheetFunction.Product(Incidence1, ((1 - Incidence1) / Application.WorksheetFunction.Sum(Denom1)))))
TestStat = (Incidence1 - Incidence2) / StndError
If Lift > 0 Then pValue = 1 - (WorksheetFunction.Norm_S_Dist(Arg1:=TestStat, Arg2:=True)) Else pValue = (WorksheetFunction.Norm_S_Dist(Arg1:=TestStat, Arg2:=True))
Output.Offset(i, 0).NumberFormat = "0.0%"
Output.Offset(i, 1).NumberFormat = "0.0%"
Output.Offset(i, 0) = Incidence1
Output.Offset(i, 1) = Incidence2
Output.Offset(i, 3) = Index
Output.Offset(i, 4) = Lift
Output.Offset(i, 5) = StndError
Output.Offset(i, 6) = TestStat
Output.Offset(i, 7) = pValue
If pValue < 0.05 Then Output.Offset(i, 8) = "Yes" Else Output.Offset(i, 8) = "No"
If Output.Offset(i, 8) = "Yes" Then Output.Offset(i, 8).Interior.ColorIndex = 35
If Output.Offset(i, 8) = "No" Then Output.Offset(i, 8).Interior.ColorIndex = 38
If Output.Offset(i, 8) = "No" Then
Do
j = j + 0.01
Loop Until j > pValue
Output.Offset(i, 9).NumberFormat = "0%"
Output.Offset(i, 9) = j
End If
If Output.Offset(i, 8) = "No" Then Output.Offset(0, 9) = "Alpha Level Significant At"
End If
Next i

For i = 1 To z
If Range(D)(i) <> "" Then
Set Num1 = Range(A)(i)
Set Denom1 = Range(B)(i)
Set Num2 = Range(C)(i)
Set Denom2 = Range(D)(i)
Set Output = Range(E)(1) 'Does not increment
Incidence1 = Num1 / Denom1
Incidence2 = Num2 / Denom2
If Incidence2 <> 0 Then Index = (Incidence1 / Incidence2) * 100 Else Index = 0
Lift = (Incidence1 - Incidence2) * 100
StndError = Sqr(Application.WorksheetFunction.Sum(Application.WorksheetFunction.Product (Incidence2, ((1 - Incidence2) / Application.WorksheetFunction.Sum(Denom2))), Application.WorksheetFunction.Product(Incidence1, ((1 - Incidence1) / Application.WorksheetFunction.Sum(Denom1)))))
TestStat = (Incidence1 - Incidence2) / StndError
If Lift > 0 Then pValue = 1 - (WorksheetFunction.Norm_S_Dist(Arg1:=TestStat, Arg2:=True)) Else pValue = (WorksheetFunction.Norm_S_Dist(Arg1:=TestStat, Arg2:=True))
Output.Offset(i, 0).NumberFormat = "0.0%"
Output.Offset(i, 1).NumberFormat = "0.0%"
Output.Offset(i, 0) = Incidence1
Output.Offset(i, 1) = Incidence2
Output.Offset(i, 3) = Index
Output.Offset(i, 4) = Lift
Output.Offset(i, 5) = StndError
Output.Offset(i, 6) = TestStat
Output.Offset(i, 7) = pValue
If pValue < 0.05 Then Output.Offset(i, 8) = "Yes" Else Output.Offset(i, 8) = "No"
If Output.Offset(i, 8) = "Yes" Then Output.Offset(i, 8).Interior.ColorIndex = 35
If Output.Offset(i, 8) = "No" Then Output.Offset(i, 8).Interior.ColorIndex = 38
If Output.Offset(i, 8) = "No" Then
Do
j = j + 0.01
Loop Until j > pValue
Output.Offset(i, 9).NumberFormat = "0%"
Output.Offset(i, 9) = j
End If
If Output.Offset(i, 8) = "No" Then Output.Offset(0, 9) = "Alpha Level Significant At"
End If
Next i

Output = "Proportion 1"
Output.Offset(0, 1) = "Proportion 2"
Output.Offset(0, 3) = "Index"
Output.Offset(0, 4) = "Lift"
Output.Offset(0, 5) = "Standard Error"
Output.Offset(0, 6) = "Test Statistic"
Output.Offset(0, 7) = "PValue"
Output.Offset(0, 8) = "(Sig @" & Confidence & "%)"
Unload Me


End Sub

[V_F]

I'm sorry, but what was done? I'm still getting a different result for that "Alpha Level Significant At" than I should be? Thank you

[Paul_Hossler]

It would probably be easier if you put sample data in your attachment, along with any instructions to run the macro, and the expected results

[SamT]

I'm sorry, but what was done? I'm still getting a different result for that "Alpha Level Significant At" than I should be? Thank you
Nothing. I just pasted your existing code.

[V_F]

Attached is an excel with some examples of what I'm expecting. When you run the macro, highlight all of the numbers in column C for 'Sample 1 Numerator', highlight all of the numbers in column D for 'Sample 1 Denominator', highlight all of the numbers in column A for 'Sample 2 Numerator', highlight all of the numbers in column B for 'Sample 2 Denominator', and for 'Output Range' click on cell P2 and click 'Compute'. From here, you should achieve the same results that are attached, but what I'm looking for is for column O to be populated. Currently I have x% in this column. Basically, if the test comes back as not significant at the selected alpha level (default is .05 if left blank in the prompt), then I want the macro to loop through and output the minimum alpha level at which the test would be significant. Hopefully this helps.

[Paul_Hossler]

I don't understand the need for the 4 loops (w, x, y, z) since the logic is / can be essentially the same

As a suggestion, I'd consider changing the architecture a little and make the 'one row' logic into a standalone subroutine, and having the driver module call the sub for each row and update the worksheet

My statistics is really fuzzy, but maybe something like this





Option Explicit
Sub drv()

'Dim workingAlpha, workingIsSignif, etc.

'for each row

'call sub Signif with input Alpha 0.05 and IsSignif = True (IsSignif changed to False maybe by sub

'do while IsSignif = True
' add .01 to Alpha
' call sub Signif with new Alpha and IsSignif = True
' since sub makes IsSignif = False if > new Alpha
'loop

'update the Output.Offset cells with returned data (Prop1, Prop2, Ndx, Lift, StdErr, TestStat, PValue,)
'next row
End Sub


'Inputs: N1, D1, N2, D2, Alpha, IsSignif
'Outputs: Prop1, Prop2, Ndx, Lift, StdErr, TestStat, PValue, IsSignif
Private Sub Signif(N2 As Double, D2 As Double, N1 As Double, D1 As Double, _
Prop1 As Double, Prop2 As Double, Ndx As Double, Lift As Double, StdErr As Double, TestStat As Double, _
PValue As Double, Alpha As Double, IsSignif As Boolean)
Dim j As Double

Prop1 = N1 / D1
Prop2 = N2 / D2

If Prop2 <> 0 Then
Ndx = (Prop1 / Prop2) * 100
Else
Ndx = 0
End If

Lift = (Prop1 - Prop2) * 100

StdErr = Sqr(Application.WorksheetFunction.Sum(Application.WorksheetFunction.Product (Prop2, ((1 - Prop2) / Application.WorksheetFunction.Sum(D2))), Application.WorksheetFunction.Product(Prop1, ((1 - Prop1) / Application.WorksheetFunction.Sum(D1)))))

TestStat = (Prop1 - Prop2) / StdErr

If Lift > 0 Then
PValue = 1 - (WorksheetFunction.Norm_S_Dist(Arg1:=TestStat, Arg2:=True))
Else
PValue = (WorksheetFunction.Norm_S_Dist(Arg1:=TestStat, Arg2:=True))
End If

IsSignif = (PValue < Alpha)
End Sub

[V_F]

I'm slightly confused by the code below. The code that I posted loops through so that it computes a significance test for each row. The only looping that I see is what is below, which only loops through for the minimum alpha level required for significance? Does the significance testing get looped through for each row? This macro is used as an add-in (see picture below).

20079
Option Explicit
Sub drv()

'Dim workingAlpha, workingIsSignif, etc.

'for each row

'call sub Signif with input Alpha 0.05 and IsSignif = True (IsSignif changed to False maybe by sub

'do while IsSignif = True
' add .01 to Alpha
' call sub Signif with new Alpha and IsSignif = True
' since sub makes IsSignif = False if > new Alpha
'loop

'update the Output.Offset cells with returned data (Prop1, Prop2, Ndx, Lift, StdErr, TestStat, PValue,)
'next row
End Sub

[Paul_Hossler]

That was just pseudo-code

I was thinking you'd do something like the macro below

BIAC, look at the attachment

BTW, your StdErr calculation can be simplified, since in VBA you can just multiply and add directly without using WS function Sum and Product




StdErr= 1.0 + (A * B / C)








Private Sub ComputeButton_Click()
Set A = Range(Sample2Numerator.Value)
Set B = Range(Sample2Denominator.Value)
Set C = Range(Sample1Numerator.Value)
Set D = Range(Sample1Denominator.Value)
Set E = Range(OutputRange.Value).Cells(1, 1)

If AlphaBox.Value = "" Then
Alpha = 0.05
Else
Alpha = AlphaBox.Value
End If
End Sub







Option Explicit

Public A As Range, B As Range, C As Range, D As Range, E As Range
Public bCanceled As Boolean
Public Alpha As Double

Sub Significance_Test_Multiple()
Dim r As Range
Dim workAlpha As Double
Dim workIsSignif As Boolean

Dim Prop1 As Double, Prop2 As Double, Ndx As Double, Lift As Double, StdErr As Double, TestStat As Double, PValue As Double
Dim N2 As Double, D2 As Double, N1 As Double, D1 As Double

Dim iRow As Long

bCanceled = False
SigTestingPrompt.Show
If bCanceled Then Exit Sub


For iRow = 1 To A.Rows.Count
workAlpha = Alpha
workIsSignif = True



N1 = C.Cells(iRow, 1).Value
D1 = D.Cells(iRow, 1).Value
N2 = A.Cells(iRow, 1).Value
D2 = B.Cells(iRow, 1).Value


Call Signif(N2, D2, N1, D1, Prop1, Prop2, Ndx, Lift, StdErr, TestStat, PValue, workAlpha, workIsSignif)

Do While Not workIsSignif And workAlpha < 0.5
workAlpha = workAlpha + 0.01
workIsSignif = True
Call Signif(N2, D2, N1, D1, Prop1, Prop2, Ndx, Lift, StdErr, TestStat, PValue, workAlpha, workIsSignif)
Loop

E.Offset(iRow - 1, 0).NumberFormat = "0.0%"
E.Offset(iRow - 1, 1).NumberFormat = "0.0%"
E.Offset(iRow - 1, 0) = Prop1
E.Offset(iRow - 1, 1) = Prop2
E.Offset(iRow - 1, 3) = Ndx
E.Offset(iRow - 1, 4) = Lift
E.Offset(iRow - 1, 5) = StdErr
E.Offset(iRow - 1, 6) = TestStat
E.Offset(iRow - 1, 7) = PValue

If PValue < Alpha Then
E.Offset(iRow - 1, 8) = "Yes"
E.Offset(iRow - 1, 8).Interior.ColorIndex = 35
Else
E.Offset(iRow - 1, 8) = "No"
E.Offset(iRow - 1, 8).Interior.ColorIndex = 38
End If

E.Offset(iRow - 1, 9) = workAlpha
E.Offset(iRow - 1, 9).NumberFormat = "0.00%"

Next

End Sub

'Inputs: N1, D1, N2, D2, Alpha, IsSignif
'Outputs: Prop1, Prop2, Ndx, Lift, StdErr, TestStat, PValue, IsSignif
Private Sub Signif(N2 As Double, D2 As Double, N1 As Double, D1 As Double, _
Prop1 As Double, Prop2 As Double, Ndx As Double, Lift As Double, StdErr As Double, TestStat As Double, _
PValue As Double, Alpha As Double, IsSignif As Boolean)
Dim j As Double

Prop1 = N1 / D1
Prop2 = N2 / D2

If Prop2 <> 0 Then
Ndx = (Prop1 / Prop2) * 100
Else
Ndx = 0
End If

Lift = (Prop1 - Prop2) * 100

StdErr = Sqr(Application.WorksheetFunction.Sum(Application.WorksheetFunction.Product (Prop2, ((1 - Prop2) / Application.WorksheetFunction.Sum(D2))), Application.WorksheetFunction.Product(Prop1, ((1 - Prop1) / Application.WorksheetFunction.Sum(D1)))))

TestStat = (Prop1 - Prop2) / StdErr

If Lift > 0 Then
PValue = 1 - (WorksheetFunction.Norm_S_Dist(Arg1:=TestStat, Arg2:=True))
Else
PValue = (WorksheetFunction.Norm_S_Dist(Arg1:=TestStat, Arg2:=True))
End If

IsSignif = (PValue < Alpha) ' this is the Alpha passed as input, I probably should have used a different variable name to avoid confusion
End Sub