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.
Bookmarks