Sub CustomKey() Dim colSports As New Collection colSports.Add "Basketball", "B" colSports.Add "Skiing", "S1" colSports.Add "Skating", "S2" colSports.Add "Hockey", "H" Debug.Print colSports.Item("S1") End Sub