Option Explicit
Sub FaceIDList()
'
' creates a cool toolbar list of face IDs with their corresponding numbers
'
'
Dim cmdbar As CommandBar
Dim cmdbtn As CommandBarButton
Dim objButton As CommandBarControl
Dim i As Long

Application.ScreenUpdating = False

   On Error Resume Next
   Application.CommandBars("Icons 0 through 500").Delete
   Application.CommandBars("Icons 501 through 1000").Delete
   Application.CommandBars("Icons 1001 through 1500").Delete
   On Error GoTo 0
    
Set cmdbar = Application.CommandBars.Add(Name:="Icons 0 through 500")
cmdbar.Visible = True

    For i = 0 To 500
        Application.StatusBar = "Creating Face ID Button " & i & " out of 500"
        Set objButton = cmdbar.Controls.Add
        With objButton
            .Style = 3
            .Caption = i
            .FaceId = i
            .Visible = True
            .TooltipText = "Face ID: " & i
        End With
    Next i

Application.StatusBar = False
Set cmdbar = Application.CommandBars.Add(Name:="Icons 501 through 1000")
cmdbar.Visible = True

    For i = 501 To 1000
        Application.StatusBar = "Creating Face ID Button " & i & " out of 1000"
        Set objButton = cmdbar.Controls.Add
        With objButton
            .Style = 3
            .Caption = i
            .FaceId = i
            .Visible = True
            .TooltipText = "Face ID: " & i
        End With
    Next i

Application.StatusBar = False
Set cmdbar = Application.CommandBars.Add(Name:="Icons 1001 through 1500")
cmdbar.Visible = True

    For i = 1001 To 1500
        Application.StatusBar = "Creating Face ID Button " & i & " out of 1500"
        Set objButton = cmdbar.Controls.Add
        With objButton
            .Style = 3
            .Caption = i
            .FaceId = i
            .Visible = True
            .TooltipText = "Face ID: " & i
        End With
    Next i

Application.StatusBar = False
Application.ScreenUpdating = True
Set objButton = Nothing
Set cmdbar = Nothing
End Sub