Hi The code below calculates the P-Value using the Range format.
From articles i have read using an Array would be far faster....But i don't know how to do it.
Your challenge should you accept it is to beat 0.054
The AD & P-value are correct, used Minitab to check.
Thanks in advance
Bernie
From articles i have read using an Array would be far faster....But i don't know how to do it.
Your challenge should you accept it is to beat 0.054
The AD & P-value are correct, used Minitab to check.
Thanks in advance
Bernie
| Cell Formulas | ||
|---|---|---|
| Range | Formula | |
| C2:C31 | C2 | =NORM.DIST(A2,1288.30923333333,0.0394755999131703,TRUE) |
| D2:D31 | D2 | =VLOOKUP(H$2+1-B2,VLdata,2,FALSE) |
| E2:E31 | E2 | =(2*B2-1)*(LN(C2)+LN(1-D2))/ 30 |
| H2 | H2 | =COUNT(A:A) |
| H3 | H3 | =STDEV.S(A:A) |
| H4 | H4 | =AVERAGE(A:A) |
| H5 | H5 | =-30-SUM(E:E) |
| H6 | H6 | =0.519648814547281*(1+0.75/30+2.25/30 ^2) |
| H7 | H7 | =EXP(0.9177-4.279*0.533939156947331-1.38*0.533939156947331^2) |
| Named Ranges | ||
|---|---|---|
| Name | Refers To | Cells |
| Imrdata | =Sheet1!$A$2:$A$31 | H2:H4, C2 |
| VLdata | =Sheet1!$B$2:$C$31 | D3:D31, D2:E2 |
| Cells with Conditional Formatting | ||||
|---|---|---|---|---|
| Cell | Condition | Cell Format | Stop If True | |
| B24 | Cell Value | duplicates | text | NO |
| B24 | Cell Value | duplicates | text | NO |
| B24 | Cell Value | duplicates | text | NO |
| B24 | Cell Value | duplicates | text | NO |
VBA Code:
Sub GetPvalue() 'Get P Value *****************************
Application.ScreenUpdating = False
'Timer***************************************************
Dim secs1 As Single
Dim secs2 As Single
secs1 = Timer()
'********************************************************
Worksheets("Sheet1").Select
Range("A:J").Select
Selection.ClearContents
Range("B1").Select
'Copy Source Data
Range("M2:M33").Select
Selection.Copy
Range("A2").Select
ActiveSheet.Paste
Range("A1").Select
'Sort Data Smallist to Largist
Range("A2:A100").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("A2:A100" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A2:A100")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
'********************************************************
'Stop
Dim Pvalue, AD, imrav, imrstdev, AjustedAD As Double
Dim Nparts As Integer
Dim Imrdata As Range
'Titles
Range("A1") = "Sorted Small to Large"
Range("B1") = "Rank"
Range("C1") = "F(Yi): Normal"
Range("D1") = "F(Yn+1-i)"
Range("E1") = "AD(S)"
Range("g2") = "No. Parts(n)"
Range("g3") = "StDev"
Range("g4") = "Mean"
Range("G5") = "Anderson Darling(AD)"
Range("G6") = "Ajusted AD"
Range("G7") = "P-Value"
Range("G9") = "Range Time"
Range("G10") = "Array Time"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=COUNT(C[-7])"
Range("H3").Select
ActiveCell.FormulaR1C1 = "=STDEV.S(C[-7])"
Range("H4").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(C[-7])"
Nparts = Range("h2")
imrstdev = Range("h3")
imrav = Range("h4")
'Imrdata Dynamic Range
Worksheets("Sheet1").Select
Set sht = Worksheets("Sheet1")
Range("A2").Select
Set StartCell = Range("A2")
LastRow = Nparts + 1
lastColumn = 1
ActiveWorkbook.Names.Add Name:="Imrdata", RefersToR1C1:= _
Range(StartCell, sht.Cells(LastRow, lastColumn))
Range("A2").Select
'Stop
'Rank Sorted Data
Digby = 0
Lr = Nparts + 1
For r = 2 To Lr '
If Not IsEmpty(Cells(r, 1)) Then
Digby = Digby + 1
Cells(r, 2).Value = Digby
End If
Next r
'Stop
'F(Yi): Normal
LastRow = Range("a2").End(xlDown).Row
If Not IsEmpty(Range("a2")) Then
Range("c2").Select
Range("c2:c" & LastRow).FormulaR1C1 = "=NORM.DIST(RC[-2]," & imrav & "," & imrstdev & ",TRUE)"
Columns("c:c").EntireColumn.AutoFit
End If
'Stop
'Create VlookUp range
Set sht = Worksheets("Sheet1")
Range("b2").Select
Set StartCell = Range("b2")
LastRow = Nparts + 1
lastColumn = 3
ActiveWorkbook.Names.Add Name:="VLdata", RefersToR1C1:= _
Range(StartCell, sht.Cells(LastRow, lastColumn))
Range("a2").Select
'Stop
'F(Yn+1-i)
LastRow = Range("a2").End(xlDown).Row
If Not IsEmpty(Range("a2")) Then
Range("d2").Select
Range("d2:d" & LastRow).FormulaR1C1 = "=VLOOKUP(R2C[4]+1-RC[-2],VLdata,2,FALSE)"
Columns("d:d").EntireColumn.AutoFit
End If
'Stop
'AD(S)
LastRow = Range("a2").End(xlDown).Row
If Not IsEmpty(Range("a2")) Then
Range("e2").Select
Range("e2:e" & LastRow).FormulaR1C1 = "=(2*RC[-3]-1)*(LN(RC[-2])+LN(1-RC[-1]))/ " & Nparts & ""
Columns("e:e").EntireColumn.AutoFit
'Stop
'Anderson Darling(AD)
Range("h5") = "=-" & Nparts & "-SUM(e:e)"
AD = Range("h5").Value
'Stop
'If AD Error
If Not IsNumeric(Range("h2")) Then
Pval = "<0.005"
Range("H7") = Pval
GoTo 101
End If
'Ajusted AD
Range("h6") = "=" & AD & "*(1+0.75/" & Nparts & "+2.25/" & Nparts & " ^2)" '
AjustedAD = Range("h6")
End If
'Stop
'P Value
If AjustedAD > 0.6 Then
Range("h7") = "=Exp(1.2937 - 5.709 * " & AjustedAD & " + 0.0186 * " & AjustedAD & " ^ 2)"
Pval = Range("h7")
ElseIf AjustedAD > 0.34 And AjustedAD < 0.6 Then
Range("h7") = "=exp(0.9177-4.279*" & AjustedAD & "-1.38*" & AjustedAD & "^2)"
Pval = Range("h7")
ElseIf AjustedAD > 0.2 And AjustedAD < 0.34 Then
Range("h7") = "= 1- exp(-8.318 + 42.796*" & AjustedAD & "-59.938*" & AjustedAD & "^2)"
Pval = Range("h7")
ElseIf AjustedAD >= 0.2 And AjustedAD < 0.34 Then
Range("h7") = "= 1- exp(-13.436 + 101.14*" & AjustedAD & "-223.73*" & AjustedAD & "^2"
Pval = Range("h7")
End If
If Range("h7").Value <= 0.005 Then
Pval = "<0.005"
Range("H7") = Pval
End If
101 ' jumps here if Ley Numbers
'*******************************************************************
'Stop
secs2 = Timer()
Worksheets("Sheet1").Range("h9").Value = secs2 - secs1
Application.CutCopyMode = True
End Sub
