VBA Excel Counting Specific Values

Question

I'm trying to write a program that will loop through cells of a specific column (assigned by the user), find new values in those cells and count how many times a specific value is found. The main problem I'm having right now is that this is hard-coded like below:

Function findValues() As Long
For iRow = 2 To g_totalRow
    If (ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text = "") Then
        nullInt = nullInt + 1
    ElseIf (someValue1 = "" Or someValue1 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
        someValue1 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
        someInt1 = someInt1 + 1
    ElseIf (someValue2 = "" Or someValue2 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
        someValue2 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
        someInt2 = someInt2 + 1
    ElseIf (someValue3 = "" Or someValue3 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
        someValue3 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
        someInt3 = someInt3 + 1
    ElseIf (someValue4 = "" Or someValue4 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
        someValue4 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
        someInt4 = someInt4 + 1
    ElseIf (someValue5 = "" Or someValue5 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
        someValue5 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
        someInt5 = someInt5 + 1
    ElseIf (someValue6 = "" Or someValue6 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
        someValue6 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
        someInt6 = someInt6 + 1
    ElseIf (someValue7 = "" Or someValue7 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
        someValue7 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
        someInt7 = someInt7 + 1
    ElseIf (someValue8 = "" Or someValue8 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
        someValue8 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
        someInt8 = someInt8 + 1
    ElseIf (someValue9 = "" Or someValue9 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
        someValue9 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
        someInt9 = someInt9 + 1
    ElseIf (someValue10 = "" Or someValue10 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text) Then
        someValue10 = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
        someInt10 = someInt10 + 1
    End If
Next iRow
End Function

Here, if the ActiveCell is blank then the nullInt will get incremented, if the ActiveCell has some value then it'll find which of the variables has that same value or the ActiveCell value will be assigned to one of the variables. I created ten variables strictly for testing purposes but I need to make up to one hundred. I was wondering if there was a way to complete this quickly. The only way I could think of was to create a String array and an Int array and store the values that way. However I'm not sure if this is the best way to get this done.

Edit This portion is directed specifically to dictionaries. Say there is a specific column titled "State". This contains the 50 North American states. Some of these states are repeated and there is a total of 800 values in this column. How do I keep track of how many times (for example) Texas gets hit?

Thank you,

Jesse Smothermon

Do you have to do this programmatically? What about using pivot tables? — steinar, Apr 04 '11 at 22:55
This code is part of a button macro I'm creating. I have to admit I'm not entirely sure what a pivot table is but I'll go look that up — Jesse Smothermon, Apr 04 '11 at 23:06

score 3 · Accepted Answer · edited May 23 '17 at 12:26

3

You should be able to do this with a Dictionary (see Does VBA have Dictionary Structure?)

This code hasn't been tested but should give you a start.

Function findValues() As Scripting.Dictionary
Dim cellValue
Dim dict As New Scripting.Dictionary

For iRow = 2 To g_totalRow

    cellValue = ActiveWorkbook.Sheets(sheetName).Cells(iRow, iCol).Text
    If dict.Exists(cellValue) Then
        dict.Item(cellValue) = dict.Item(cellValue) + 1
    Else
        dict.Item(cellValue) = 1
    End If
Next iRow

Set findValues = dict

End Function


Sub displayValues(dict As Scripting.Dictionary)
    Dim i
    Dim value
    Dim valueCount

    For i = 1 To dict.count
        valueCount = dict.Items(i)
        value = dict.Keys(i)

        ActiveWorkbook.Sheets(sheetName).Cells(i, 3).Text = value
        ActiveWorkbook.Sheets(sheetName).Cells(i, 4).Text = valueCount
    Next i

End Sub

Sub RunAndDisplay()
    Dim dict

    Set dict = findValues

    displayValues dict

End Sub

edited May 23 '17 at 12:26

Community

1
1

answered Apr 04 '11 at 23:08

grantnz

7,322
1
31
38

Whoa.... Sorry I'm so new to coding in general I didn't even know there was a thing called a dictionary. It'll take me a couple days to get comfortable enough to use this but I'll definitely get back to you. Thank you! – Jesse Smothermon Apr 04 '11 at 23:14
Do you know how to would print out the contents of the dictionary into excel cells? My hope is that it would print out the key in one cell and the count (number of times that key is found) in the adjacent cell. All I've found on the topic so far is to print the values out into message boxes – Jesse Smothermon Apr 05 '11 at 20:25
I've added another function displayValues to display the contents of the dictionary (and a RunAndDisplay sub that exercises the functions). Again, this is untested code so there probably is some debugging to do. Also, I've hardcoded the output columns to 3 & 4 (which are entirely arbitrary column numbers) – grantnz Apr 06 '11 at 01:03
Note: In Excel 2007 VBA Editor -> Tools -> References -> Microsoft Scripting RunTime – John M Jan 25 '12 at 21:24

Tiago Cardoso · Answer 2 · 2011-04-06T03:13:36.023

I've drafted a code for you, hope it helps. I added comments to make each step clearer for you. I believe that simply setting the proper values in the 1st step might make it work for you.

Still, would worth to understand what the code does to help you in the future.

Hope it fits your needs!

Option Explicit

Sub compareValues()

    Dim oSource As Excel.Range
    Dim oColumn As Excel.Range
    Dim oCell As Excel.Range
    Dim sBookName As String
    Dim sSheetCompare As String
    Dim sSheetSource As String
    Dim sUserCol As String
    Dim sOutputCol As String
    Dim sFirstCell As String
    Dim vDicItem As Variant
    Dim sKey As String
    Dim iCount As Integer
    Dim sOutput As String
    Dim oDic As Scripting.Dictionary

    '1st - Define your source for somevalues and for the data to be compared
    sBookName = "Book1"
    sSheetCompare = "Sheet1"
    sSheetSource = "Sheet2"
    sFirstCell = "A1"
    sOutputCol = "C"

    '2nd - Define the 'somevalues' origin value; other values will be taken
    '   from the rows below the original value (i.e., we'll take our
    '   somevalues starting from sSheetSource.sFirstCell and moving to the
    '   next row until the next row is empty
    Set oSource = Workbooks(sBookName).Sheets(sSheetSource).Range(sFirstCell)

    '3rd - Populate our dictionary with the values beggining in the sFirstCell
    populateDic oSource, oDic

    'At this stage, we have all somevalues in our dictionary; to check if the
    '   valuesare as expected, uncomment the code below, that will print into
    '   immediate window (ctrl+G) the values in the dictionary

    For Each vDicItem In oDic

        Debug.Print vDicItem

    Next vDicItem

    '4th - ask the user for the column he wants to use; Use single letters.
    '   E.g.: A
    sUserCol = InputBox("Enter the column the data will be compared")

    '5th - scan the column given by the user for the values in the dictionary
    Set oColumn = Workbooks(sBookName).Sheets(sSheetCompare).Columns(sUserCol)

    '6th - Now, we scan every cell in the column
    For Each oCell In oColumn.Cells

        sKey = oCell.Value

        '7th - Test the special case when the cell is empty
        If sKey = "" Then oDic("Empty") = oDic("Empty") + 1

        '8th - Test if the key value exists in the dictionary; if so, add it
        If oDic.Exists(sKey) Then oDic(sKey) = oDic(sKey) + 1

        '9th - Added to exit the for when row reaches 1000.
        If oCell.Row = 1000 Then Exit For

    Next oCell

    '10th - Now, we print back the counters we found, only for sample purposes
    '   From now on, is up to you how to use the dictionary :)

    iCount = 1

    Set oColumn = Workbooks(sBookName).Sheets(sSheetCompare).Columns(sOutputCol)
    Set oCell = oColumn.Cells(1, 1)

    For Each vDicItem In oDic

        If oDic(vDicItem) > 0 Then

            oCell.Value = vDicItem
            oCell.Offset(0, 1).Value = oDic(vDicItem)

            Set oCell = oCell.Offset(1, 0)

        End If

    Next vDicItem

End Sub

Sub populateDic(ByRef oSource As Excel.Range, _
    ByRef oDic As Scripting.Dictionary)



    'Ideally we'd test if it's created. Let's just set it for code simplicity
    Set oDic = New Scripting.Dictionary

    'Let's add an 'empty' counter for the empty cells
    oDic.Add "Empty", 0

    While Len(oSource.Value) > 0

        'If the data is not added into somevalues dictionary of values, we add
        If Not oDic.Exists(oSource.Value) Then oDic.Add CStr(oSource.Value), 0

        'Move our cell to the next row
        Set oSource = oSource.Offset(1, 0)

    Wend

End Sub

Does the Debug.Print show something in a message box? I'm trying to figure out if there's a way to print the dictionary out into the excel cells — Jesse Smothermon, Apr 05 '11 at 21:43
Code updated to print the values directly into the cells, not using the debug.print anymore. — Tiago Cardoso, Apr 06 '11 at 03:14

VBA Excel Counting Specific Values

2 Answers2