Sub Macro1()
On Error Resume Next
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim rng As Range, cell As Range
Dim FindString As String
Dim rng2 As Range
Dim count As Long
Dim myRow As Range
Set rng = Sheets("Sheet1").Range("Y2:Y100000")
For Each cell In rng
count = 0
FindString = cell.Offset(0, -24).Value
For Each myRow In Range("A2:X100000").Rows
If myRow.Cells(1, 10).Value = "yes" And myRow.Cells(1, 1).Value = FindString Then
count = count + 1
End If
If count > 0 Then Exit For
Next myRow
If count > 0 Then
cell.Value = "yes"
Else
cell.Value = "no"
End If
Next cell
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub
Bookmarks