Sub Test() Dim cl As FountainColor If ActiveShape.Fill.Type <> cdrFountainFill Then MsgBox "The selected shape must have a fountain fill." Exit Sub End If For Each cl In ActiveShape.Fill.Fountain.Colors If cl.Position < 100 And cl.Position > 50 Then cl.Delete Next cl End Sub