Option Explicit
Sub Test()
Call AddMaterial(Material:="TEST_XYZ", Serials:="TEST_SN_XYZ")
Stop
Call AddMaterial(Material:="TEST_0123456789", Serials:=Array("TEST_001", "TEST_002", "TEST_003"))
Stop
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
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
Set rngMaterial = rngMaterial.Offset(rngMaterial.Rows.Count - 1).Cells(1)
Call rngMaterial.Offset(1).Resize(nSerials).EntireRow.Insert(xlShiftDown)
Set rngMaterial = rngMaterial.Offset(1)
Else
Set rngMaterial = GetMaterials
If Not rngMaterial Is Nothing Then
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
rngMaterial.Resize(nSerials).Value = Material
For Each vntSerial In vntSerials
rngMaterial.Offset(0, 1).Value = vntSerial
Set rngMaterial = rngMaterial.Offset(1)
Next
AddMaterial = True
End Function
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
n = 1
Do While rngMaterial.Offset(n).Value = rngMaterial.Value
n = n + 1
Loop
Set MaterialRange = rngMaterial.Resize(n)
MaterialExists = True
End Function
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
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