Counting Instances of a Dropdown List Value

[karoloydi]

Hi,

I have 30 dropdown lists on my document. Each List Has 10 different options (red, blue, pink, green, etc.)

I want to make a code that goes through the document and calculates the total of times each color has been selected on all of the 30 lists.

I ve been trying to find someone witha similar question to me fo rhours now with no luck. I appreciate your help.

[gmaxey]

Assuming the dropdowns are ContentControls then something like this:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 9/9/2017
Dim oCC As ContentControl
Dim lngIndex As Long
Dim lngCount As Long
Dim arrColors() As String
  lngCount = ActiveDocument.ContentControls.Count
  ReDim arrColors(1 To lngCount)
  For lngIndex = 1 To ActiveDocument.ContentControls.Count
    arrColors(lngIndex) = ActiveDocument.ContentControls(lngIndex).Range.Text
  Next
  MsgBox UBound(Filter(arrColors, "Blue")) + 1
  MsgBox UBound(Filter(arrColors, "Red")) + 1
  MsgBox UBound(Filter(arrColors, "Pink")) + 1
  MsgBox UBound(Filter(arrColors, "Green")) + 1
lbl_Exit:
  Exit Sub
End Sub

[karoloydi]

Thank you. The concept works. But what I really want is to automatically update a form in the document.
I want to have a table in the bottom of the document that says:

Blue:
Red:
Green:
Pink:

SO I think I need to change this part from MsgBox to InsertText and DisplayText (sorry, I'm clueless):

MsgBox UBound(Filter(arrColors, "Blue")) + 1
    MsgBox UBound(Filter(arrColors, "Red")) + 1
    MsgBox UBound(Filter(arrColors, "Pink")) + 1
    MsgBox UBound(Filter(arrColors, "Green")) + 1

And then the fields are automatically updated, or at least to be updated when I press a shortcut or even better a button or something similar to that.
I think I can create a macro button for that, is that correct?

It would be great if you could show me how to do that.

[gmayor]

With a little modification and a change of direction you can update the count automatically by using the content control on exit event

Put the following code in the document's ThisDocument module. Put a bookmark at the end of each row of your table i.e. bmBlue, bmRed, bmGreen, bmPink as appropriate and then as the items are selected and you click outside the fields the colour count is updated. (see attached)

Option Explicit

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim lngIndex As Long
Dim lngCount As Long
Dim arrColors() As String
    lngCount = ActiveDocument.ContentControls.Count
    ReDim arrColors(1 To lngCount)
    For lngIndex = 1 To ActiveDocument.ContentControls.Count
        arrColors(lngIndex) = ActiveDocument.ContentControls(lngIndex).Range.Text
    Next
    FillBM "bmBlue", UBound(Filter(arrColors, "Blue")) + 1
    FillBM "bmRed", UBound(Filter(arrColors, "Red")) + 1
    FillBM "bmGreen", UBound(Filter(arrColors, "Pink")) + 1
    FillBM "bmPink", UBound(Filter(arrColors, "Green")) + 1
lbl_Exit:
    Exit Sub
End Sub


Private Sub FillBM(strbmName As String, strValue As String)
'Graham Mayor - http://www.gmayor.com
Dim oRng As Range
    With ActiveDocument
        On Error GoTo lbl_Exit
        Set oRng = .Bookmarks(strbmName).Range
        oRng.Text = strValue
        oRng.Bookmarks.Add strbmName
    End With
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub

[karoloydi]

Thank you! That's amazing. I have 2 problems.

One problem is that whenever I run the file for the first time and also other times randomly I can't select any option on the droplist for about 2-3 minutes. It keeps loading something. Is it possible to search only for the droplist with specific title instead of looking in the whole document? Maybe that will help.

Second problem, when I try to combine it with the following code it is giving me error
"Ambiguous Name Detected Document Content Control On Exit"
I am placing the following code at the end of the code you gave me

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
 Dim i As Long, StrDetails As String
With ContentControl
   Select Case .Title
     Case Is = "Planner"
       For i = 1 To .DropdownListEntries.Count
         If .DropdownListEntries(i).Text = .Range.Text Then
           StrDetails = Replace(.DropdownListEntries(i).Value, "|", Chr(11))
           Exit For
         End If
       Next
       ActiveDocument.SelectContentControlsByTag("Planner").Item(1).Range.Text = StrDetails
     Case Else
   End Select
 End With
 End Sub

[karoloydi]

That's the complete code I'm trying to use.

Option Explicit
 
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
    Dim lngIndex As Long
    Dim lngCount As Long
    Dim arrColors() As String
    lngCount = ActiveDocument.ContentControls.Count
    ReDim arrColors(1 To lngCount)
    For lngIndex = 1 To ActiveDocument.ContentControls.Count
        arrColors(lngIndex) = ActiveDocument.ContentControls(lngIndex).Range.Text
    Next
    FillBM "bmAccident", UBound(Filter(arrColors, "Accident Report")) + 1
    FillBM "bmBalcony", UBound(Filter(arrColors, "Balcony")) + 1
    FillBM "bmDoorLock", UBound(Filter(arrColors, "Door Lock")) + 1
    FillBM "bmIncident", UBound(Filter(arrColors, "Incident Report")) + 1
    FillBM "bmKeyFault", UBound(Filter(arrColors, "Key Fault")) + 1
    FillBM "bmLostFoundLogged", UBound(Filter(arrColors, "L & F Logged")) + 1
    FillBM "bmLostFoundReturned", UBound(Filter(arrColors, "L & F Returned")) + 1
    FillBM "bmLockRead", UBound(Filter(arrColors, "Lock Read")) + 1
    FillBM "bmSafe", UBound(Filter(arrColors, "Safe")) + 1
    FillBM "bmTheft", UBound(Filter(arrColors, "Theft Allegation")) + 1
    FillBM "bmEscort", UBound(Filter(arrColors, "Escort")) + 1
    FillBM "bmIDCheck", UBound(Filter(arrColors, "ID Check")) + 1
lbl_Exit:
    
 End Sub
    

 
 
Private Sub FillBM(strbmName As String, strValue As String)
    
    Dim oRng As Range
    With ActiveDocument
        On Error GoTo lbl_Exit
        Set oRng = .Bookmarks(strbmName).Range
        oRng.Text = strValue
        oRng.Bookmarks.Add strbmName
    End With
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub


Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim i As Long, StrDetails As String
With ContentControl
  Select Case .Title
    Case Is = "Planner"
      For i = 1 To .DropdownListEntries.Count
        If .DropdownListEntries(i).Text = .Range.Text Then
          StrDetails = Replace(.DropdownListEntries(i).Value, "|", Chr(11))
          Exit For
        End If
      Next
      ActiveDocument.SelectContentControlsByTag("Planner").Item(1).Range.Text = StrDetails
    Case Else
  End Select
End With
End Sub

[gmaxey]

You keep moving the goal post after the start of the game!

You will have to define something unique about the 30 CCs out of X total in the document that figure in the tally. E.g., you could tag them with "ColorCC"

"Ambiguous Name" no surprise there. You can't have two procedures in the same module with the same name.

If you want to write to a table as you indicated after the first goal post move then something like;

Option Explicit
Private oTbl As Table
Private lngColorCCCount As Long
Sub Document_Open()
  lngColorCCCount = ActiveDocument.SelectContentControlsByTag("ColorCC").Count
End Sub
Sub Document_New()
  lngColorCCCount = ActiveDocument.SelectContentControlsByTag("ColorCC").Count
End Sub
Private Sub Document_ContentControlOnExit(ByVal oCC As ContentControl, Cancel As Boolean)
Dim lngIndex As Long
Dim arrColors() As String
Dim strDetails As String
  Select Case oCC.Tag
    Case "ColorCC"
      Set oTbl = ActiveDocument.Tables(1) 'or whatever table it is.
      ReDim arrColors(1 To lngColorCCCount)
      For lngIndex = 1 To ActiveDocument.SelectContentControlsByTag("ColorCC").Count
        arrColors(lngIndex) = ActiveDocument.SelectContentControlsByTag("ColorCC").Item(lngIndex).Range.Text
      Next
      'Fills x row, 2 column table with value in column 2.
      FillTable 1, UBound(Filter(arrColors, "Blue")) + 1
      FillTable 2, UBound(Filter(arrColors, "Red")) + 1
      FillTable 3, UBound(Filter(arrColors, "Pink")) + 1
      FillTable 4, UBound(Filter(arrColors, "Green")) + 1
    Case Else
      Select Case oCC.Title
        Case "Planner"
          With oCC
            For lngIndex = 1 To .DropdownListEntries.Count
              If .DropdownListEntries(lngIndex).Text = .Range.Text Then
                strDetails = Replace(.DropdownListEntries(lngIndex).Value, "|", Chr(11))
                  Exit For
                End If
            Next
            .Type = wdContentControlText
            .Range.Text = strDetails
            .Type = wdContentControlDropdownList
          End With
        Case Else
      End Select
  End Select
lbl_Exit:
  Set oTbl = Nothing
  Exit Sub
End Sub
Sub FillTable(lngRow As Long, strValue As String)
  oTbl.Cell(lngRow, 2).Range.Text = strValue
End Sub

[macropod]

Cross-posted at: https://windowssecrets.com/forums/sh...own-List-Value
Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq...._new_faq_item3

[gmaxey]

Paul,

Thanks. At least this hasn't been a complete waste of Graham's and my time.

[karoloydi]

Thank you guyz. It works now

[tgamekh]

Assuming the dropdowns are ContentControls then something like this:

Sub ScratchMacro()
Dim oCC As ContentControl
Dim lngIndex As Long
Dim lngCount As Long
Dim arrColors() As String
  lngCount = ActiveDocument.ContentControls.Count
  ReDim arrColors(1 To lngCount)
  For lngIndex = 1 To ActiveDocument.ContentControls.Count
    arrColors(lngIndex) = ActiveDocument.ContentControls(lngIndex).Range.Text
  Next
  MsgBox UBound(Filter(arrColors, "Blue")) + 1
  MsgBox UBound(Filter(arrColors, "Red")) + 1
  MsgBox UBound(Filter(arrColors, "Pink")) + 1
  MsgBox UBound(Filter(arrColors, "Green")) + 1
lbl_Exit:
  Exit Sub
End Sub

Hello,

Is there a way to combine all of the results from the above code into one MsgBox with each result listed on it's own line?

Something along the lines of:

Blue = 3
Red = 4
Pink = 1
Green = 5


Thank you!

[macropod]

That's pretty basic VBA code, really...

MsgBox _
  "Blue:  " & UBound(Filter(arrColors, "Blue")) + 1 & vbCr & _
  "Red:   " & UBound(Filter(arrColors, "Red")) + 1 & vbCr & _
  "Pink:  " & UBound(Filter(arrColors, "Pink")) + 1 & vbCr & _
  "Green: " & UBound(Filter(arrColors, "Green")) + 1

[tgamekh]

That's pretty basic VBA code, really...

MsgBox _
  "Blue:  " & UBound(Filter(arrColors, "Blue")) + 1 & vbCr & _
  "Red:   " & UBound(Filter(arrColors, "Red")) + 1 & vbCr & _
  "Pink:  " & UBound(Filter(arrColors, "Pink")) + 1 & vbCr & _
  "Green: " & UBound(Filter(arrColors, "Green")) + 1

Thank you. I am still starting out and find that I am biting off bigger projects than I can sometimes chew. Your help is greatly appreciated.