i have not used that many if stetements before....
Sub vbax_53617_Fill_Cells_If_Val_Exists_In_Another_Sheet_v4()
Dim i As Long, j As Long
Dim tempStr As String
With Worksheets("Sheet1")
.AutoFilterMode = False
.Range("A2:A" & .Rows.Count).ClearContents
For i = 2 To .Range("B" & .Rows.Count).End(xlUp).Row
If Application.CountIf(Worksheets("Sheet2").Range("G:G"), .Range("B" & i)) = 0 Then
.Range("A" & i).Value = "Not found"
Else
tempStr = ""
For j = 2 To Worksheets("Sheet2").Range("G" & Rows.Count).End(xlUp).Row
If .Range("B" & i).Value = Worksheets("Sheet2").Range("G" & j).Value And _
Application.CountIfs(Worksheets("Sheet2").Range("E2:E" & j), Worksheets("Sheet2").Range("E" & j), _
Worksheets("Sheet2").Range("G2:G" & j), Worksheets("Sheet2").Range("G" & j)) = 1 Then
tempStr = tempStr & " and " & Worksheets("Sheet2").Range("E" & j).Value
End If
Next j
.Range("A" & i).Value = Mid(tempStr, 6)
End If
If Len(Trim(.Range("C" & i))) > 0 Then
If Application.CountIf(Worksheets("Sheet2").Range("G:G"), .Range("C" & i)) = 0 Then
If .Range("A" & i).Value = "" Then .Range("A" & i).Value = "Not found"
Else
tempStr = .Range("A" & i).Value
If tempStr = "Not found" Then tempStr = ""
For j = 2 To Worksheets("Sheet2").Range("G" & Rows.Count).End(xlUp).Row
If .Range("C" & i).Value = Worksheets("Sheet2").Range("G" & j).Value And _
Application.CountIfs(Worksheets("Sheet2").Range("E2:E" & j), Worksheets("Sheet2").Range("E" & j), _
Worksheets("Sheet2").Range("G2:G" & j), Worksheets("Sheet2").Range("G" & j)) = 1 Then
tempStr = tempStr & " and " & Worksheets("Sheet2").Range("E" & j).Value
End If
Next j
If Left(tempStr, 5) = " and " Then tempStr = Mid(tempStr, 6)
.Range("A" & i).Value = tempStr
End If
End If
If Len(Trim(.Range("D" & i))) > 0 Then
If Application.CountIf(Worksheets("Sheet2").Range("G:G"), .Range("D" & i)) = 0 Then
If .Range("A" & i).Value = "" Then .Range("A" & i).Value = "Not found"
Else
tempStr = .Range("A" & i).Value
For j = 2 To Worksheets("Sheet2").Range("G" & Rows.Count).End(xlUp).Row
If .Range("D" & i).Value = Worksheets("Sheet2").Range("G" & j).Value And _
Application.CountIfs(Worksheets("Sheet2").Range("E2:E" & j), Worksheets("Sheet2").Range("E" & j), _
Worksheets("Sheet2").Range("G2:G" & j), Worksheets("Sheet2").Range("G" & j)) = 1 Then
tempStr = tempStr & " and " & Worksheets("Sheet2").Range("E" & j).Value
End If
Next j
If Left(tempStr, 5) = " and " Then tempStr = Mid(tempStr, 6)
.Range("A" & i).Value = tempStr
End If
End If
Next i
End With
End Sub