So I've created a collected based off the selected items and I have it showing only unique values which displays the collection in a MsgBox. How do I get it to count how many of each item it counted and displayed that next to it in the MsgBox.
For Each itm In colCol1 Txt = Txt & itm & vbNewLine Next itm
msgBox Txt
Example:
20 Hats
15 Shirts
5 Scarves
I tried a method like this one time and failed....so I decided to assign each count to a textbox on a form.
Dim sr As ShapeRange
Private Sub cmdCount_Click()
Set sr = ActiveSelectionRange
txtboxHats = sr.Count
txtboxShirts = sr.Count
txtboxScarves = sr.Count
End Sub
'Maybe something like this could work for you?
Here is a simple example for you. Create a number of shapes and name them, Hat, Shirt and Scarves. It will add each of them to a Collection. It then loops that collection and totals each item.
Sub CollectionSummary() Dim colSample As New Collection Dim vElement As Variant Dim strName 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 MsgBox "Example:" & Chr(10) & Chr(10) & _ intHats & " Hats" & Chr(10) & _ intShirts & " Shirts" & Chr(10) & _ intScarves & " Scarves", , "Collection Summary" End Sub
Hope that helps,
-Shelby
This helps plenty but is there a way to exclude an item from the message box if its value is 0? Thanks for the reply Shelby!!
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