..... Butter an den Fisch ;-)

Shapes erzeugen nach Liste

Option Explicit
Rem zeichne fehlende nach Vorgabe in Liste
Rem Mindestanforderung 1 Objekt vom Typ
Sub ZeichneNachListe()
Dim shShapes As Worksheet, shLists As Worksheet
Dim rngList  As Range, rngCell  As Range
Dim objShpe As Shape  'Testobjekte sind vom Typ 5 (msoShapeRoundedRectangle) !!!
Dim sngSTop As Single, sngLeft As Single
   
  'die Tabellenobjekte
  Set shShapes = Sheets("Checklist Structure")
  Set shLists = Sheets("Lists")
  
  'der Listenbereich
  Set rngList = shLists.Cells(Rows.Count, "D").End(xlUp)
  Set rngList = shLists.Range("D3:G" & rngList.Row)
  rngList.Interior.ColorIndex = xlColorIndexNone  'rücksetzen
  
  'im Listenbereich durch die Zellen
  For Each rngCell In rngList
    'prüfe jedes Zeichnungsobjekt in der Tabelle wo
    For Each objShpe In shShapes.Shapes
      If objShpe.TextFrame2.TextRange.Text = rngCell.Value Then _
        rngCell.Interior.ColorIndex = 4 'Grün ist die Farbe der Hoffnung
    Next objShpe
  Next rngCell
  
  'Treffer vertauschen
  For Each rngCell In rngList
    If rngCell.Interior.ColorIndex = xlColorIndexNone And _
      rngCell.Value <> "" Then _
        rngCell.Interior.ColorIndex = 3
  Next rngCell
  
  'jetzt die fehlenden ergänzen
  'unter "richtigem" Einsatz von With.....End With
  With shShapes
    For Each rngCell In rngList
      If rngCell.Interior.ColorIndex = 3 Then 'A Vog'l singt im Gart'n
        sngSTop = .Shapes(.Shapes.Count).Top
        sngSTop = sngSTop + .Shapes(.Shapes.Count).Height + 10  'Annahme
        sngLeft = .Shapes(.Shapes.Count).Left 'schön untereinander
        Set objShpe = .Shapes(.Shapes.Count).Duplicate  'und de Blumen blüh'n.
        With objShpe
          .TextFrame2.TextRange.Characters.Text = rngCell.Value 'Text ändern
          'die Eigenschaften .Left und .Top usw. setzen
          .Top = sngSTop  'Und wanns'd ned boid zu mir kummst
          .Left = sngLeft 'is ollas aus fia mi.
        End With
      End If
    Next rngCell
  End With
End Sub

und aus den gleichen Bausteinen brät´s du dir eine Löschroutine

Option Explicit
Rem lösche fehlende nach Vorgabe in Liste
Rem Mindestanforderung Objekte vom Typ
Sub LöscheNachListe()
Dim shShapes As Worksheet, shLists As Worksheet
Dim rngList  As Range, rngCell  As Range
Dim objShpe As Shape  'Testobjekte sind vom Typ 5 (msoShapeRoundedRectangle) !!!
Dim sngy As Single, sngx As Single
Dim lngCnt As Long

  'die Tabellenobjekte
  Set shShapes = Sheets("Checklist Structure")
  Set shLists = Sheets("Lists")
  
  'der Listenbereich
  Set rngList = shLists.Cells(Rows.Count, "D").End(xlUp)
  Set rngList = shLists.Range("D3:G" & rngList.Row)
    
  'Position 1. Shape
  sngx = shShapes.Shapes(1).Left
  sngy = shShapes.Shapes(1).Top
    
  'in der Shapes Auflistung durch die Objekte
  For Each objShpe In shShapes.Shapes
    If rngList.Find( _
      What:=objShpe.TextFrame2.TextRange.Characters.Text, _
      LookAt:=xlWhole, _
      MatchCase:=True) Is Nothing Then
      objShpe.Delete
      ActiveWorkbook.Save
      Exit For
    End If
  Next objShpe

  'jetzt aufrücken durch zählen
  lngCnt = 1
  For Each objShpe In shShapes.Shapes
    If lngCnt = 1 Then
      shShapes.Shapes(lngCnt).Top = sngy
      shShapes.Shapes(lngCnt).Left = sngx
    Else
      shShapes.Shapes(lngCnt).Top = shShapes.Shapes(lngCnt - 1).Top + _
        shShapes.Shapes(lngCnt - 1).Height + 10                       'Annahme
      shShapes.Shapes(lngCnt).Left = shShapes.Shapes(lngCnt - 1).Left
    End If
    lngCnt = lngCnt + 1
  Next objShpe

End Sub

jetzt komponierst du dir noch eine feine Marinade,

 vom Geschmack "Private Sub Worksheet_Change(ByVal Target As Range)"

und fertig ist das  :O Fleischgericht :O