In Teilprobleme zerlegen und runterproggen:

Falls du die Referenz auf einen Bereich als Rückgabe brauchst, siehst du das am Beispiel von MaterialExists.

Option Explicit

Sub Test()
  
  'neuer Material-Eintrag
  Call AddMaterial(Material:="TEST_XYZ", Serials:="TEST_SN_XYZ")
  Stop
  Call AddMaterial(Material:="TEST_0123456789", Serials:=Array("TEST_001", "TEST_002", "TEST_003"))
  Stop
  
  'Material-Eintrag zu bereits vorhandenen Material (=Anfügen)
  Call AddMaterial(Material:="6MF10130CJ380AA0BB", Serials:="TEST_SN_6MF10130CJ380AA0BB")
  Stop
  Call AddMaterial(Material:="6MF10130CF510AA0CC", Serials:=Array("TEST_SN_6MF11112AJ200AA0GG_1", "TEST_SN_6MF11112AJ200AA0GG_2"))
  Stop
  
End Sub

'////////////////////////////////
'// Hilfsfunktion:
'//  Seriennummern für (ggf. neues) Material eintragen
Public Function AddMaterial(Material As String, Serials As Variant) As Boolean
  
  Dim rngMaterial As Excel.Range
  Dim vntSerials  As Variant
  Dim vntSerial   As Variant
  Dim nSerials    As Long
  
  If (VarType(Serials) And vbArray) = vbArray Then
    nSerials = UBound(Serials) - LBound(Serials) + 1
    vntSerials = Serials
  Else
    nSerials = 1
    vntSerials = Array(Serials)
  End If
  
  If MaterialExists(Material, rngMaterial) Then
    'unterhalb des letzten Eintrags Platz für neue Serials schaffen
    Set rngMaterial = rngMaterial.Offset(rngMaterial.Rows.Count - 1).Cells(1)
    Call rngMaterial.Offset(1).Resize(nSerials).EntireRow.Insert(xlShiftDown)
    'erste Zelle für neue Einträge referenzieren
    Set rngMaterial = rngMaterial.Offset(1)
  Else
    Set rngMaterial = GetMaterials
    If Not rngMaterial Is Nothing Then
      'erste Zelle für neue Einträge referenzieren
      Set rngMaterial = rngMaterial.Offset(rngMaterial.Rows.Count).Cells(1)
    Else
      Set rngMaterial = GetMaterialHeader
      If rngMaterial Is Nothing Then
        Call MsgBox("Material-Spalte wurde nicht gefunden.", vbCritical, "AddMaterial ist fehgeschlagen")
        Exit Function
      End If
      Set rngMaterial = rngMaterial.Offset(1)
    End If
  End If
  
  'Material eintragen
  rngMaterial.Resize(nSerials).Value = Material
  
  'Serials eintragen
  For Each vntSerial In vntSerials
    rngMaterial.Offset(0, 1).Value = vntSerial
    Set rngMaterial = rngMaterial.Offset(1)
  Next
  
  AddMaterial = True
  
End Function


'////////////////////////////////
'// Hilfsfunktion:
'//  sieht nach ob Einträge zu einem Material existieren
'//  liefert optional den Bereich mit dem gefundenen Material
Public Function MaterialExists(Material As String, Optional ByRef MaterialRange As Excel.Range) As Boolean
  
  Dim rngMaterial   As Excel.Range
  Dim rngMaterials  As Excel.Range
  Dim n             As Long
  
  Set rngMaterials = GetMaterials
  If rngMaterials Is Nothing Then Exit Function
  
  Set rngMaterial = rngMaterials.Find(Material, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=False)
  If rngMaterial Is Nothing Then Exit Function
  
  'weitere Treffer direkt darunter?
  n = 1
  Do While rngMaterial.Offset(n).Value = rngMaterial.Value
    n = n + 1
  Loop
  
  Set MaterialRange = rngMaterial.Resize(n)
  
  MaterialExists = True
  
End Function

'////////////////////////////////
'// Hilfsfunktion:
'//  liefert den Bereich der Materialen
Private Function GetMaterials() As Excel.Range
  
  Dim rngHeader As Excel.Range
  Dim rngData As Excel.Range
  
  With ThisWorkbook.Worksheets("Sample")
    
    Set rngHeader = GetMaterialHeader
    If rngHeader Is Nothing Then Exit Function
    
    Set rngData = .Range(rngHeader.Offset(1), .Cells(.Rows.Count, rngHeader.Column).End(xlUp))
    If rngData.Row < rngHeader.Offset(1).Row Then Exit Function
    
  End With
  
  Set GetMaterials = rngData
  
End Function

'////////////////////////////////
'// Hilfsfunktion:
'//  liefert die Zelle mit dem Inhalt "Material"
Private Function GetMaterialHeader() As Excel.Range
  
  On Error GoTo ErrHandler
  
  Dim rngHeader As Excel.Range
  
  With ThisWorkbook.Worksheets("Sample")
    Set rngHeader = .Columns("A").Find("Material", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=False)
    If rngHeader Is Nothing Then Exit Function
  End With
  
  Set GetMaterialHeader = rngHeader
  
Exit Function
ErrHandler:
  Set GetMaterialHeader = Nothing
End Function