Ich habe es jetzt mal wie von Gast56740 vorgeschlagen mit Select Case probiert und es funktioniert soweit auch sehr gut.

Meine Frage bzw. Bitte wäre aber trotzdem ob sich jemand den Code mal anschauen und mir sagen kann was ich da noch verbessern oder verfeinern kann. Ich würde daraus ja auch gerne lernen.........

Besten Dank aber schon mal bis hierhin für die Hilfe.

Sub UpdateShapesArPl()

Dim startRow As Long, LastRow As Long
Dim namesCol As String, colorCol As String
Dim i As Long, j As Long
Dim shpAltName As String, cellColor As Long
Dim shp As Shape
Dim newShapes As String, deletedShapes As String
Dim isShapeInData As Boolean

startRow = 2
namesCol = "B"
colorCol = "B"

LastRow = Sheet008.Cells(Sheet008.Rows.Count, namesCol).End(xlUp).Row

For i = startRow To LastRow

shpAltName = Sheet008.Cells(i, namesCol).Value
cellColor = Sheet008.Cells(i, colorCol).DisplayFormat.Interior.Color

Set shp = Nothing
For Each potentialShape In Sheet009.Shapes

If potentialShape.AlternativeText = shpAltName Then

Set shp = potentialShape
Exit For

End If

Next potentialShape

If shp Is Nothing Then
Select Case Sheet008.Cells(i, namesCol).Offset(0, -1).Value

Case "ArPl_kurz"
Set shp = Sheet009.Shapes.AddShape(msoShapeRectangle, 650, 30, 40, 25)
shp.AlternativeText = shpAltName
shp.Fill.ForeColor.RGB = cellColor
shp.TextFrame.Characters.Text = shpAltName
shp.TextFrame.Characters.Font.Color = RGB(0, 0, 0)
shp.TextFrame.Characters.Font.Name = "Arial"
shp.TextFrame.Characters.Font.Size = 5
shp.TextFrame.Characters.Font.Bold = False
shp.Name = shpAltName

Case "Halle_kurz"
Set shp = Sheet009.Shapes.AddShape(msoShapeDownArrowCallout, 700, 30, 40, 30)
shp.AlternativeText = shpAltName
shp.Fill.ForeColor.RGB = cellColor
shp.TextFrame.Characters.Text = shpAltName
shp.TextFrame.Characters.Font.Color = RGB(0, 0, 0)
shp.TextFrame.Characters.Font.Name = "Arial"
shp.TextFrame.Characters.Font.Size = 11
shp.TextFrame.Characters.Font.Bold = True
shp.Name = shpAltName

Case "IT_kurz"
Set shp = Sheet009.Shapes.AddShape(msoShapeFlowchartDecision, 750, 30, 25, 25)
shp.AlternativeText = shpAltName
shp.Fill.ForeColor.RGB = cellColor
shp.TextFrame.Characters.Text = shpAltName
shp.TextFrame.Characters.Font.Color = RGB(0, 0, 0)
shp.TextFrame.Characters.Font.Name = "Arial"
shp.TextFrame.Characters.Font.Size = 5
shp.TextFrame.Characters.Font.Bold = False
shp.Name = shpAltName

Case "LOTO_kurz"
Set shp = Sheet009.Shapes.AddShape(msoShapeDonut, 800, 30, 10, 10)
shp.AlternativeText = shpAltName
shp.Fill.ForeColor.RGB = cellColor
shp.TextFrame.Characters.Text = shpAltName
shp.TextFrame.Characters.Font.Color = RGB(0, 0, 0)
shp.TextFrame.Characters.Font.Name = "Arial"
shp.TextFrame.Characters.Font.Size = 5
shp.TextFrame.Characters.Font.Bold = False
shp.Name = shpAltName

End Select

If newShapes = "" Then

newShapes = shpAltName
Else
newShapes = newShapes & vbNewLine & shpAltName
End If

End If

Next i

For Each shp In Sheet009.Shapes
shpAltName = shp.AlternativeText
isShapeInData = False

For j = startRow To LastRow
If Sheet008.Cells(j, namesCol).Value = shpAltName Then
isShapeInData = True
Exit For
End If

Next j

If Not isShapeInData And shpAltName <> "" Then
If deletedShapes = "" Then
deletedShapes = shpAltName
Else
deletedShapes = deletedShapes & vbNewLine & shpAltName
End If
shp.Delete
End If

Next shp

Dim message As String

If newShapes <> "" Then
message = "Folgende Shapes werden erstellt:" & vbNewLine & newShapes
MsgBox message, vbInformation, "Update neue Shapes"
End If

If deletedShapes <> "" Then
message = message & "Folgende Shapes werden gelöscht" & vbNewLine & deletedShapes
MsgBox message, vbInformation, "Update gelöschte Shapes"
End If

If message = "" Then
message = "Ausgewähltes Element" & vbNewLine & _
"wird im Layout angezeigt"
MsgBox message, vbInformation, "Update Auswahl"
End If

End Sub