Sub Test() Dim fx As Long, cs As Long Dim pal As Palette fx = 0 cs = 0 For Each pal In Palettes Select Case pal.Type Case cdrFixedPalette fx = fx + 1 Case cdrCustomPalette cs = cs + 1 End Select Next pal MsgBox "Total palettes open: " & Palettes.Count & vbCr & _ "Fixed palettes: " & fx & vbCr & _ "Custom palettes: " & csEnd Sub