Sub Testen()

Dim strMaterial As String
Dim arrV() As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

   'Hier wähle ich das Material aus
   strMaterial = InputBox("Ihre Auswahl")
   If Len(strMaterial) < 1 Then Exit Sub
   'Ich mach mir eine Hilfs-Arbeitsmappe
   HilfsArbeitsmappe "Hilfstabelle"
   'meine Auflistung in "Tabelle4"
   'mein Material in Spalte "E"
   'mein Diagramm in Spalte "I"
   arrV = Unikatliste("Tabelle4", "Hilfstabelle", "E", "I", strMaterial)
   Sheets("Hilfstabelle").Delete
   'mein Test
   MsgBox Join(arrV, vbNewLine)

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Function Unikatliste(strA As String, strH As String, _
   colM As String, colD As String, strMat As String) As Variant

Dim ShA As Excel.Worksheet
Dim ShH As Excel.Worksheet

Dim rngF As Range, rngA As Range, rngR As Range, c As Range
Dim strarr As String, vArr() As String, i As Integer
   
   
   Set ShA = Sheets(strA)
   Set ShH = Sheets(strH)
   
   With ShH
      .AutoFilterMode = False
      .Cells.Clear
      ShA.Columns(colM).Copy .Range("A1")
      ShA.Columns(colD).Copy .Range("B1")
      With .UsedRange.Columns("C")
         .FormulaR1C1 = "=RC[-2]&RC[-1]"
         .Value = .Value
      End With
      .UsedRange.RemoveDuplicates Columns:=3, Header:=xlNo
      .UsedRange.AutoFilter Field:=3, Criteria1:= _
        "=" & strMat & "*", Operator:=xlAnd
      Set rngF = .UsedRange.SpecialCells(12)
      For Each rngA In rngF.Areas
         For Each rngR In rngA.Rows
            If rngR.Cells(1).Value = strMat Then
               ReDim Preserve vArr(0 To i)
               vArr(i) = rngR.Cells(2).Value
               i = i + 1
            End If
         Next rngR
      Next rngA
   End With

   Unikatliste = vArr
   
End Function

Private Sub HilfsArbeitsmappe(strName As String)
Dim Sh As Excel.Worksheet

   For Each Sh In Sheets
      If Sh.Name = strName Then Exit For
   Next Sh
   If Sh Is Nothing Then
      Sheets.Add
      ActiveSheet.Name = strName
   End If
   
End Sub