CODEWITHSUNDEEP
vbaexcelexcel-formulapivot-tablefind-occurrences
Noldor130884
Noldor130884

Reputation: 994

Excel-VBA: Count occurrencies of a different strings and list them

Today I have the following problem: I have 2 columns of x rows (doesn't matter how many) in Excel with a string in each one, like this

   A                B
 Apple            Potato
 Banana           Potato
 Apple            Potato
 Orange           Apple

Each string can appear in both column.

I need to obtain the following results:

Fruit          Occurrencies
Apple               3
Banana              1
Potato              3
Orange              1

Now, I know for sure that there's a way much faster than what I could think of and I'd appreciate any help you can give. My solution would consist in storing one by one the strings in an array checking each time if they are already contained in the slots before the current one and, if not, counting its occurrencies too. For example after having stored all the strings in an array (which I will now call Fruit()):

Dim Str() As Variant
Dim Flag As Boolean

For i = LBound(Fruit)+1 to Ubound(Fruit)
    Flag = True
    For j = i to LBound(Fruit)
        If Fruit(i) = Fruit(j) Then
            Flag = False
            Exit For
        End If
    Next
    If Flag = True Then
        Str(k,0) = Fruit(i)
        For y = LBound(Fruit) to UBound(Fruit)
            if Str(k,0) = Fruit(y) Then Str(k,1) = Str(k,1)+1
        Next
        k = k+1
    End If
Next

This is totally crazy and I know there's an easier solution... I just can't find it.

Upvotes: 0

Views: 2926

Answers (2)

Noldor130884
Noldor130884

Reputation: 994

Checking yours as a correct answer and +1 for help, but I wanted to share with the community the effort to make this work for an array too: 

Private Function FilesCount(SourceRange As Range) As Variant

    Dim SourceMem As Object
    Dim Occurrencies() As Variant
    Dim OneCell As Range
    Dim i As Integer

    Set SourceMem = CreateObject("Scripting.dictionary")

    For Each OneCell In SourceRange
        On Error GoTo Hell
        SourceMem.Add OneCell.Value, 1
        On Error GoTo 0
    Next

    ReDim Occurrencies(SourceMem.Count - 1, 1)

    For i = 0 To SourceMem.Count - 1
        Occurrencies(i, 0) = SourceMem.Keys()(i)
        Occurrencies(i, 1) = SourceMem.Items()(i)
    Next i

    Set SourceMem = Nothing

    FilesCount = Occurrencies

    Exit Function

Hell:

    SourceMem(OneCell.Value) = SourceMem(OneCell.Value) + 1
    Resume Next

End Function

It returns an (n x 2) array, in which there are n names and their occurrence in the selected range

Upvotes: 0

IAmDranged
IAmDranged

Reputation: 3020

You can use the dictionary object, it looks pretty straightforward to me

Sub fruitsCount()

    Dim sourceRange As Range
    Dim sourceMem As Object
    Dim curRow as integer

    'CHANGE TO WHATEVER SHEET NAME YOUR ARE USING
    With Worksheets("SOURCE_SHEET")
        Set sourceRange = .Range("A1:B" & .Range("A" & .Rows.count).End(xlUp).row)
    End with

    Set sourceMem = CreateObject("Scripting.dictionary")

    For Each cell In sourceRange
        On Error GoTo ERREUR
        sourceMem.Add cell.Value, 1
        On Error GoTo 0
    Next

    curRow = 2

    'CHANGE TO WHATEVER SHEET NAME YOUR ARE USING
    With Worksheets("DESTINATION_SHEET")
        .Range("A1").Value = "Fruit"
        .Range("B1").Value = "Occurencies"
        For Each k In sourceMem.Keys
            .Range("A" & curRow).Value = k
            .Range("B" & curRow).Value = sourceMem(k)
            curRow = curRow + 1
        Next k
    End With

    Set sourceMem = Nothing

    Exit Sub

ERREUR:

    sourceMem(cell.Value) = sourceMem(cell.Value) + 1
    Resume Next

End Sub

Edit: the logic behind the code is actually fairly simple, and relies on the dictionary object which allows to garner (key, value) pairs. Here the keys will be the fruit names, and the values the number of occurences for each fruit. The distinctive feature of the dictionary object the code relies on is that it won't allow duplicate keys - any time you try and add a key that already exists in the dictionary, a runtime error will be issued.

So the code just scans through each and every cell of your source range and it tries to add its value as a key to the dictionary:

  • if the operation succeeds, then this is the first occurence for that fruit in the source range - it is added as a key to the dictionary, and its paired value is set to 1
  • else, the fruit already exists as a key in the dictionary - and thus an error occurs when trying to add the fruit to the dictionary. The code then jumps to the ERREUR error hanlder to increment the value paired with that existing fruit key in the dictionary, and resume normal execution from there

Hopes that helps clarifying

Upvotes: 1

Related Questions