outlier per column

[lferreira]

I have a macro that is building an array. The array has 400 columns and 1000 rows. I need outliers identified from each data column, not the total data cloud. I have to post the data in the worksheet first and then do the calculation. I'm using the code below. The code calculates the values in the worksheet. But it takes too long to calculate. I need to speed up the code, but I can not find the correct syntax. I'd like to first calculate in the array and then throw them in the worksheet. Is it possible? Thx for support.

Sub outliers()
Dim mAvg As Double, mStdD As Double
Dim rData As Range, rCell As Range, Rng As Range
Set rData = Range("B2:OK1001")
For Each rCell In rData.Columns
mAvg = WorksheetFunction.Average(rCell )
mStdD = WorksheetFunction.StDev(rCell )
For i = 1 To rCell .Cells.Count
Set Rng = rCell .Cells(i, 1)
If Rng <> "-" Then
If Rng <> "" Then
If Rng > mAvg + 1 * mStdD Or Rng < mAvg - 1 * mStdD Then
Rng.Value = "Outlier"
End If: End If: End If
Next i: Next
End Sub

 

[lferreira]

Yes, of course. Is a very simple code.

Dim v_spot1(1000, 2) As Variant
Dim v_imp1A(1000, 400) As Variant
Dim cont_seg As Integer
Sub Copia_3_Segundos()
Set wb = ThisWorkbook
Application.ScreenUpdating = False

If cont_seg < 1000 Then

cont_seg = cont_seg + 1

With wb.Worksheets("Grava")

'''''PETR4'''''

'''''1° Vencimento'''''

'Data, Ativo
v_spot1(cont_seg, 1) = .Range("I2").Value
v_spot1(cont_seg, 2) = .Range("J2").Value

'vol imp média
v_imp1A(cont_seg, 1) = .Range("AL8").Value
v_imp1A(cont_seg, 2) = .Range("AM8").Value
v_imp1A(cont_seg, 3) = .Range("AN8").Value
v_imp1A(cont_seg, 4) = .Range("AO8").Value
v_imp1A(cont_seg, 5) = .Range("AP8").Value
v_imp1A(cont_seg, 6) = .Range("AQ8").Value
v_imp1A(cont_seg, 7) = .Range("AR8").Value
v_imp1A(cont_seg, 8) = .Range("AS8").Value
v_imp1A(cont_seg, 9) = .Range("AT8").Value
v_imp1A(cont_seg, 10) = .Range("AU8").Value
'and keeps going....
End With


Application.ScreenUpdating = True
Call timer_Seg

Else
cont_seg = 0

Application.ScreenUpdating = True

Exit Sub

End If

End Sub
Sub timer_Seg()
Application.OnTime Now + TimeValue("00:00:03"), "Copia_3_Segundos"

End Sub
<strike></strike>
​