VBA Vergleich zweier Spalten

Option Compare Text
Option Explicit

Sub Compare()
    Dim cell As Range, rngSearch As Range, f As Range, itm As Range, rngStart As Range
    Const NOTFOUNDTXT = "nicht gefunden"  
    
    With ActiveSheet
        Set rngStart = .Range("A2")  
        For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)  
            If cell.Value Like "Einkauf *" Then  
                Set rngSearch = FindSearchRange(cell.Value, "Einkauf *", .Range("E:E"))  
                For Each itm In .Range(rngStart, cell.Offset(-1, 0))
                    If Not rngSearch Is Nothing Then
                        Set f = rngSearch.Find(itm.Value)
                        If Not f Is Nothing Then
                            itm.Offset(0, 1).Value = f.Offset(0, 1).Value
                        Else
                            itm.Offset(0, 1).Value = NOTFOUNDTXT
                        End If
                    Else
                        itm.Offset(0, 1).Value = NOTFOUNDTXT
                    End If
                Next
                Set rngStart = cell.Offset(1, 0)
            End If
        Next
        
        Set rngStart = .Range("E1")  
        For Each cell In .Range("E1:E" & .Cells(Rows.Count, "E").End(xlUp).Row)  
            If cell.Value Like "Einkauf *" Then  
                Set rngSearch = FindSearchRange(cell.Value, "Einkauf *", .Range("A:A"))  
                For Each itm In .Range(rngStart, cell.Offset(-1, 0))
                    If rngSearch Is Nothing Then
                        itm.Offset(0, 2).Value = NOTFOUNDTXT
                    Else
                        Set f = rngSearch.Find(itm.Value)
                        If f Is Nothing Then
                            itm.Offset(0, 2).Value = NOTFOUNDTXT
                        End If
                    End If
                Next
                Set rngStart = cell.Offset(1, 0)
            End If
        Next
        
    End With
End Sub


Function FindSearchRange(strSearchStart As String, strSearchEnd As String, rngCol As Range) As Range
    Dim r1 As Range, r2 As Range
    Set r1 = rngCol.Find(strSearchStart)
    If strSearchStart = "" Or r1 Is Nothing Then  
        Set FindSearchRange = Nothing
        Exit Function
    End If
    Set r1 = r1.Offset(-1, 0)
    Set r2 = Range(r1, Cells(1, rngCol.Column)).Find(strSearchEnd, SearchDirection:=xlPrevious)
    If Not r2 Is Nothing Then
        Set r2 = r2.Offset(1, 0)
    Else
        Set r2 = Cells(1, rngCol.Column)
    End If
    Set FindSearchRange = Range(r1, r2)
End Function