Hallo zusammen :-)

Was ich habe:

Eine Mess-Software erzeugt eine Tabelle mit verschiedenen Spalten, alles Messwerte zu bestimmten Stoffen. Das sieht dann bspw so aus:

Spalte 1 # Spalte 2 # Spalte 3 # Spalte 4 # Spalte 5
Cu           # Ti            # Ni            #  Mn          # Cr

Weiterhin habe ich eine Liste aller möglichen zu messenden Stoffe, d.h. alles was theoretisch aus meinem Messprogramm rauskommen kann.

Was ich suche:

Meine Mess-Software erzeugt nun immer nur die Stoffe die auch gemessen wurden. Zwar schaffe ich es diese Spalten in gewünschter Reihenfolge zu sortieren jedoch möchte ich dass bspw die "Ti"-Spalte IMMER die 7te Spalte ist. Egal ob da nun 1 oder 10 andere Spalten von meinem Messprogramm kamen.

Was mein Skript also tun sollte:

Vergleich mit "Soll-Liste" ob das erste Element (hier könnte das bspw. "AL" sein) in den Messergebnissen dabei ist.
Wenn ja, dann in erste Spalte verschieben
Wenn nein, dann neue erste Spalte einfügen mit Überschrift "AL"

Dann Vergleich mit "Soll-Liste" ob das zweite Element (hier könnte das bspw. "Cr" sein) in den Messergebnissen dabei ist.
Wenn ja, dann in erste Spalte verschieben
Wenn nein, dann neue erste Spalte einfügen mit Überschrift "Cr"

Hier ist mein Code der bisher "nur" die Spalten in der gewünschten Reihenfolge sortiert jedoch NICHT fehlende Elemente einfügt:

Sub ElementeAnordnen()
    
    Dim arrColOrder As Variant, ndx As Integer
    Dim Found As Range, counter As Integer
    
    'Meine insgesamt vorhandenen Elemente in gewünschter Reihenfolge
    arrColOrder = Array("Al", "Cr", "Cu", "Mn", "Mo", "Ti")
    
    counter = 1
    
    Application.ScreenUpdating = False
    
    For ndx = LBound(arrColOrder) To UBound(arrColOrder)
        
        ' Sucht nur in Zeile 20 nach den Werten aus dem oberen Array
        ' Alles andere wird in der bestehenden Reihenfolge rechts daneben stehengelassen
        Set Found = Rows("20:20").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
                          SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        
        If Not Found Is Nothing Then
            If Found.Column <> counter Then
                Found.EntireColumn.Cut
                Columns(counter).Insert Shift:=xlToRight
                Application.CutCopyMode = False
            End If
            counter = counter + 1
        End If
        
    Next ndx
    
    Application.ScreenUpdating = True
    
End Sub