So sollte das gehen, musst nur den Pfad zur Textdate noch anpassen, oder sie in den gleichen Ordner wie die Excel Mappe packen und "Test.txt" nennen...

Option Explicit

Function ZellenFärben()
Dim rng As Range, AV, R&, C&, SerienNummer, SachNummer, Found()
Dim Path$, S1$, S2$
    
    Path = ThisWorkbook.Path & "\Test.txt" 'Pfad zur Textdatei...
    Set rng = ActiveSheet.UsedRange 'Bereich in dem Zellen gesucht und gefärbt werden sollen
    If rng.Columns.Count < 4 Then Exit Function
    With rng
        .Interior.ColorIndex = xlNone
        AV = .Value
    End With
    
    For R = 1 To UBound(AV)
        S1 = AV(R, 2)
        S2 = AV(R, 4)
        If Not S1 = "" And Not S2 = "" Then
            Select Case FindSN(S1, S2, Path) 'Suche in der Spalte rechts neben der gefundenen Nummer nach FAIL bzw. PASS
            Case 2
                rng(R, 4).Interior.ColorIndex = 3
            Case 3
                rng(R, 4).Interior.ColorIndex = 4
            End Select
        End If
    Next
     
End Function
 
Private Function FindSN(SachNummer, SerienNummer, Path$) As Integer
Dim List$(), FileName$, I&, TS$
     
    If Not OpenTxt(List, Path) Then Exit Function
    For I = 0 To UBound(List)
        TS = List(I)
        If InStr(1, TS, SachNummer) Then
            FindSN = 1
            If InStr(1, TS, SerienNummer) Then
                FindSN = 2
                If InStr(1, TS, "PASS") Then
                    FindSN = 3
                    Exit For
                End If
            End If
        End If
    Next
 
End Function
 
'open file
    Private Function OpenTxt(FileData$(), ByVal FileName$) As Boolean
    On Error GoTo BadData
    Dim FileNum%, Fields$, I&
             
        'create file
            FileNum = FreeFile
            ReDim FileData(0 To 0)
             
        'open file for input
            Open FileName For Input As FileNum
                Do While Not EOF(FileNum)
                 
                  Line Input #FileNum, Fields
                   
                  ReDim Preserve FileData(0 To I)
                  FileData(I) = Fields
                  I = I + 1
                   
                Loop
            Close
             
            FileName = 0
            Fields = 0
            I = 0
             
            OpenTxt = True
             
    Exit Function
BadData:
    End Function

Code in ein VBA Standardmodul packen und ausführen...