Welche Seriennummer?

Wenn die Sachnummer in der Texdatei vorhanden ist dann nach einer (vom Benutzer definierten?) Seriennummer in irgendeinem Tabellenblatt suchen?

Du erwähnst auch leider mit keinem Wort das Programm den Status einer Seriennummer erfahren kann...

Option Explicit

Function ZellenFärben()
Dim rng As Range, AV, R&, C&, SerienNummer, SachNummer
    
    SerienNummer = 324223 'Sachnummer
    SachNummer = 2052355 'woher soll das Programm die kennen? Eingabe vom Nutzer?
    
    If Not FindSN(SachNummer) Then
        MsgBox "Sachnummer konnte nicht gefunden werden."
        Exit Function
    End If
    
    Set rng = ActiveSheet.Range("A1:H100") 'Bereich in dem Zellen gesucht und gefärbt werden sollen
    AV = rng.Value
    For R = 1 To UBound(AV)
        For C = 1 To UBound(AV, 2)
            
            If AV(R, C) = SerienNummer Then
                Select Case AV(R, C + 1) 'Suche in der Spalte rechts neben der gefundenen Nummer nach FAIL bzw. PASS
                Case "FAIL"
                    rng(R, C).Interior.ColorIndex = 3
                Case "PASS"
                    rng(R, C).Interior.ColorIndex = 4
                End Select
            End If
        Next
    Next
    
End Function

Private Function FindSN(SachNummer) As Boolean
Dim List$(), FileName$, I&
    
    If Not OpenTxt(List, ThisWorkbook.Path & "\Test.txt") Then Exit Function 'Pfad muss angepasst werden...
    For I = 0 To UBound(List)
        If InStr(1, List(I), SachNummer) Then
            FindSN = True
            Exit Function
        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