tzexu1610
03-15-2018, 01:59 AM
Hello,
I've got a dataset of many stores, with each stores having 2 varians (A and B).
Ive been asked to do a few tasks and have written a code to get a few of them done but I am now stuck.
1) Remove all #VALUE! (done)
2) absolute value all z score (done)
2) If there is a zscore outlier, highlight its corresponding result (done). outlier is if the absolute value is > 3
3) I now need to find the sole maximum value under zscore (excluding the already selected outliers), and highlight its corresponding result. but i cant seem to continue on my code for that.
this is my code:
Sub Stage1()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Dim i As Integer
Dim j As Integer
Dim a As Long
Dim myLastRow As Integer
Dim myLastColumn As Integer
i = 10 'Start Row
j = 3 'Z-score column
myLastRow = Range("A" & Rows.Count).End(xlUp).Row
'remove error'
For a = 1 To 2
On Error Resume Next
Cells(a, j).SpecialCells(xlCellTypeFormulas, 16).ClearContents
On Error GoTo 0
Next a
'Stage 1 outlier removal
j = -1
Do
j = j + 4
Do
If Cells(i, j - 1).Errors.Item(xlNumberAsText).Value = False Then 'result NOT stored as text'
If (Cells(i, j).Value >= -3 And Cells(i, j) <= 3) Then 'not outlier'
i = i + 1
ElseIf IsEmpty(Cells(i, j)) = True Then 'Skip blank cell'
i = i + 1
Else
Cells(i, j - 1).Value = "'" & Cells(i, j - 1).Value 'Result is now text'
i = 10 'restart at first row
End If
Else
i = i + 1
End If
Loop Until i > myLastRow
Loop Until Cells(9, j).Value = ""
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub
Sub Stage2()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Dim i As Integer
Dim j As Integer
Dim a As Long
Dim b As Long
Dim myLastRow As Integer
Dim myLastColumn As Integer
Dim Absolute As Double
Dim Absolute2 As Double
i = 10 'Start Row
j = 3 'Z-score column
myLastRow = Range("A" & Rows.Count).End(xlUp).Row
'remove error'
For a = 1 To 2
On Error Resume Next
Cells(a, j).SpecialCells(xlCellTypeFormulas, 16).ClearContents
On Error GoTo 0
Next a
'Stage 2 outlier check'
j = -1
j = j + 4
'absolute value everything'
For b = 1 To myLastRow
Cells(i, j).Value = Abs(Cells(i, j).Value)
Next b
j = j - 1
Do
j = j + 4
Do
If Cells(i, j - 1).Errors.Item(xlNumberAsText).Value = False Then 'result NOT stored as text'
If (Cells(i, j).Value < 3) Then 'not outlier'
i = i + 1
ElseIf IsEmpty(Cells(i, j)) = True Then 'Skip blank cell'
i = i + 1
Else
Cells(i, j - 1).Value = "'" & Cells(i, j - 1).Value 'Result is now text'
i = 10 'restart at first row
End If
Else
i = i + 1
End If
Loop Until i > myLastRow
Loop Until Cells(9, j).Value = ""
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Function
End Sub
any help would be greatly appreciated
I've got a dataset of many stores, with each stores having 2 varians (A and B).
Ive been asked to do a few tasks and have written a code to get a few of them done but I am now stuck.
1) Remove all #VALUE! (done)
2) absolute value all z score (done)
2) If there is a zscore outlier, highlight its corresponding result (done). outlier is if the absolute value is > 3
3) I now need to find the sole maximum value under zscore (excluding the already selected outliers), and highlight its corresponding result. but i cant seem to continue on my code for that.
this is my code:
Sub Stage1()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Dim i As Integer
Dim j As Integer
Dim a As Long
Dim myLastRow As Integer
Dim myLastColumn As Integer
i = 10 'Start Row
j = 3 'Z-score column
myLastRow = Range("A" & Rows.Count).End(xlUp).Row
'remove error'
For a = 1 To 2
On Error Resume Next
Cells(a, j).SpecialCells(xlCellTypeFormulas, 16).ClearContents
On Error GoTo 0
Next a
'Stage 1 outlier removal
j = -1
Do
j = j + 4
Do
If Cells(i, j - 1).Errors.Item(xlNumberAsText).Value = False Then 'result NOT stored as text'
If (Cells(i, j).Value >= -3 And Cells(i, j) <= 3) Then 'not outlier'
i = i + 1
ElseIf IsEmpty(Cells(i, j)) = True Then 'Skip blank cell'
i = i + 1
Else
Cells(i, j - 1).Value = "'" & Cells(i, j - 1).Value 'Result is now text'
i = 10 'restart at first row
End If
Else
i = i + 1
End If
Loop Until i > myLastRow
Loop Until Cells(9, j).Value = ""
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub
Sub Stage2()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Dim i As Integer
Dim j As Integer
Dim a As Long
Dim b As Long
Dim myLastRow As Integer
Dim myLastColumn As Integer
Dim Absolute As Double
Dim Absolute2 As Double
i = 10 'Start Row
j = 3 'Z-score column
myLastRow = Range("A" & Rows.Count).End(xlUp).Row
'remove error'
For a = 1 To 2
On Error Resume Next
Cells(a, j).SpecialCells(xlCellTypeFormulas, 16).ClearContents
On Error GoTo 0
Next a
'Stage 2 outlier check'
j = -1
j = j + 4
'absolute value everything'
For b = 1 To myLastRow
Cells(i, j).Value = Abs(Cells(i, j).Value)
Next b
j = j - 1
Do
j = j + 4
Do
If Cells(i, j - 1).Errors.Item(xlNumberAsText).Value = False Then 'result NOT stored as text'
If (Cells(i, j).Value < 3) Then 'not outlier'
i = i + 1
ElseIf IsEmpty(Cells(i, j)) = True Then 'Skip blank cell'
i = i + 1
Else
Cells(i, j - 1).Value = "'" & Cells(i, j - 1).Value 'Result is now text'
i = 10 'restart at first row
End If
Else
i = i + 1
End If
Loop Until i > myLastRow
Loop Until Cells(9, j).Value = ""
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Function
End Sub
any help would be greatly appreciated