I'm trying to do some criteria automation on sheet activate but I just cannot get it to work. I have it automatically pulling matching rows from another sheet. What I want it to do is to insert a new column then from that insert some text if the column to the left of the new column matches some criteria.

Private Sub Worksheet_Activate()
Dim LR As Long
Dim cell As Range, rng As Range
Dim MyRange As Range, c As Range
Dim strCellValue As String

Worksheets("930").Range("A2:K8000").Clear            
With Sheets("Data")
    .AutoFilterMode = False
    .Range("$A$1:$J$8000").AutoFilter Field:=1, Criteria1:=Array( _
    "Y0031", "Y0036", "Y0038", "Y0041", "Y0331", "Y0393", "Y38RF", _
    "Y930", "Y930R"), Operator:=xlFilterValues       
    LR = .Range("A" & .Rows.Count).End(xlUp).Row    
    If LR > 1 Then
        .Range("A2:J" & LR).Copy Range("A2")        
    Else
        Range("A2") = "No data found"             
    End If
    .AutoFilterMode = False                         
End With


With Sheets("930")
    .Range("F:F").Insert Shift:=xlToRight
    Range("F1").Select
    ActiveCell = "TOOLTYPE"
    Range("E2").Select
    Set rng = Intersect(Range("E:E"), ActiveSheet.UsedRange)
    For Each cell In rng
    strCellValue = (cell.Value)
    If InStr(strCellValue, "Safety") > 0 Then
       ActiveCell.Offset(0, 1) = "Safety"
        'Else: Set del = Union(del, cell)
    End If
    Next cell
    On Error Resume Next
End With


End Sub
The above code is supposed to look for the string "safety" within the cell range. Then if there is a match, insert "Safety" into the next column. Can someone help me figure out why it's not working? The insert column works correctly.