Question

I am new to VBA but have previous experience with PHP programming logic and various stats programming syntax. I am trying to write a code to search through a series of cell ranges for a specific value– if that value exists in the range I want it to insert a 1 into an array, and if it doesn’t to insert a 0.

My data look something like:

**Item  R1  R2**
1121    1   3
1121    2   
1121        
1121    3   2
1121    3   
1122    4   5
1122    3   5
1122    5   
1122    4   
1122    5   

My end goal is to be able to sum the values in the array and count the total number of items with each rating. For example, in the sample above I would want to be able to produce:

Number of Items with Rating of 1 = 1

Number of Items with Rating of 2 = 1

Number of Items with Rating of 3 = 2

And so on.

The code I wrote was:

Sub Items()

    Dim myArray() As Variant
    Dim i As Integer
    Dim k As Integer
    i = 0
    k = 0
    R5 = Range("G(2+k):H(6+k)")
    mycount = Application.WorksheetFunction.Sum(myArray)


    Sheets("Operational").Select

    For Each R5 In Range("G2:H206")
        ReDim myArray(0 To i)
        myArray(i) = Cell.Value
        i = i + 1
        k = k + 4

        R5.Select
        If R5.Value = "1" Then
            myArray(i) = 1
        Else
            myArray(i) = 0
        End If
    Next

End Sub

I have 5 rows for each item so I thought I could approach this as a repeating, consistent loop. However I get an error when I try to run it – “Application-defined or object-defined error.”

I know this is probably not the best way and I am so new to this I don’t know where to start in troubleshooting. Any help would be much appreciated.

Also if anyone has a good reference for VBA structure/code or a beginner’s tutorial, let me know! I haven’t had much luck in finding any good references.

Answer 1

You’ll need to change a few things to make this work out. I’ve changed/added comments to your code below…

Option Explicit ' Helps with ensuring all variables are declared correctly.

' Need to add reference to 'Microsoft Scripting Runtime' when using Scripting.Dictionary

Sub Items()

Dim Ratings As Range
Dim cell As Range
Dim ItemTracking As New Scripting.Dictionary
Dim DictKey As Variant

    ' Use SET to assign objects
    Set Ratings = ActiveSheet.Range("B2:H206") ' The Range takes (in this case) a complete STRING argument, which can be manipulated with variables through concatenation with '&'.

    For Each cell In Ratings ' First column is R1, second is R2, etc.
        If Len(Trim$(ActiveSheet.Range("A" & cell.Row).Value)) > 0 Then ' Make sure we actually have an item before continuing...
            If Val(cell.Value) > 0 Then ' Make sure we have a rating before continuing...
                DictKey = Trim$(ActiveSheet.Range("A" & cell.Row).Value) & "R" & cell.Column - 1 & "V" & Val(cell.Value) ' If you need a more descriptive output than '1121 R1V1`, then just change this to match. Be careful of the string concatenation/variable usage.
                If ItemTracking.Exists(DictKey) Then ' When using a Dictionary (versus a Collection), we have the nifty Exists() function to help us see if we already have something.
                    ' If we do, add to it...
                    ItemTracking.Item(DictKey) = ItemTracking.Item(DictKey) + 1
                Else
                    ' Else, we do not, add it to the Dictionary.
                    ItemTracking.Add DictKey, 1
                End If
            End If
        End If
    Next

    For Each DictKey In ItemTracking
        Debug.Print DictKey & " - " & ItemTracking.Item(DictKey)
    Next

End Sub

I have used the Scripting.Dictionary to get this. To use, you’ll need to reference the Microsoft Scripting Runtime library (see comments in code). This doesn’t do much useful, just prints the results to the immediate window, but you can modify to get what you need, I think.