I have code that adds and that if an answer is provided based on a certain criteria it adds itself to a list. As I have been troubleshooting the rest of the program I have accrued a lot of answers that have been added. If I select the cells it blinks in and out and if I try to delete manually it gets stuck in a 'loop' and in order to do anything I have to crash excel.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'sorts supervisor add list
Const myCol As String = "H"
Const N As Long = 2
Dim r As Long
If Not Intersect(Target, Range(myCol & ":" & myCol)) Is Nothing Then
r = Cells(Rows.Count, myCol).End(xlUp).Row
If r < N Then r = N
With Sheet2.Sort
.SortFields.Clear
.SortFields.add Key:=Range(myCol & N), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range(myCol & N & ":" & myCol & r)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For x = r To N + 1 Step -1
If Cells(x, myCol).Value = Cells(x - 1, myCol).Value Then Cells(x, _ myCol).Delete shift:=xlUp
Next
End If
The error appears to occur on
If Cells(x, myCol).Value = Cells(x - 1, myCol).Value Then Cells(x, _ myCol).Delete shift:=xlUp
also it has had problems deleting the duplicates.