Just add a couple Ifs to check if the value is greater than 0, like this: Sub CollectionSummary() Dim colSample As New Collection Dim vElement As Variant Dim strName As String , strMessage As String Dim sr As ShapeRange Dim s As Shape Dim intHats As Integer , intShirts As Integer , intScarves As Integer intHats = 0 intShirts = 0 intScarves = 0 Set sr = ActiveSelectionRange For Each s In sr.Shapes colSample.Add s.Name Next s For Each vElement In colSample If vElement = "Hat" Then intHats = intHats + 1 If vElement = "Shirt" Then intShirts = intShirts + 1 If vElement = "Scarve" Then intScarves = intScarves + 1 Next vElement strMessage = "Example: " & Chr(10) & Chr(10) If intHats > 0 Then strMessage = strMessage & intHats & " Hats" & Chr(10) If intShirts > 0 Then strMessage = strMessage & intShirts & " Shirts" & Chr(10) If intScarves > 0 Then strMessage = strMessage & intScarves & " Scarves" & Chr(10) MsgBox strMessage, , "Collection Summary" End Sub Hope that helps, -Shelby
↧