VBA - If Range Includes Value Then Array(i) = 1, Loop, Sum

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.

Since you did ask, take a look here for some starting pointers. — Gaffi
– Gaffi, Commented Jun 27, 2012 at 14:50

Scott Holtzman · Accepted Answer · 2012-06-27 16:34:28Z

2

If I read what you are asking correctly, you can do this very easily and much more simply, without VBA.

Here a screenshot of the solution.

Columns H:K perform a CountIf on each Rating Column for each Item (see formula bar). Column G is a simple Sum of H:K for each rating.

enter image description here

UPDATE

To reflect Ratings by Item, the non-VBA approach becomes this:

enter image description here

You could re-arrange or modify this to make it prettier, probably. Also, you can get a unique list of Item numbers by coping the Item numbers to a new range and using remove duplicates (XL2007 and above) or Advanced Filter > Unique Values (XL2003). Also, if you are on XL 2003, the CountIFs won't work, you need to use a =Count(If( array formula. I can explain if need be.

edited Jun 27, 2012 at 16:34

answered Jun 27, 2012 at 16:09

Scott Holtzman

27.3k5 gold badges42 silver badges76 bronze badges

Sign up to request clarification or add additional context in comments.

7 Comments

Gaffi Over a year ago

While this is not incorrect, it doesn't fully address the question, I think. The OP is also asking for grouping by Item (1121, 1122). I could see this with a VLOOKUP() added in, but then I feel like that becomes a little more complicated.

ESmyth5988 Over a year ago

I actually want to find out the frequency of each rating value (1-5) indexed by item number. So if there are multiple ratings of a value for a specific item number, it is only counted once in the final sum. This will present me with a list of the number of items with each rating. Also, I need to do this for multiple datasets and thus it would be much simpler if I had a script written and didn't have to edit individual cells as much.

Scott Holtzman Over a year ago

I wasn't quite sure if was what is needed. I edited my posting to reflect rating counts by Item number without VBA, as well.

ESmyth5988 Over a year ago

Thanks for thinking about this problem! In order to get the output I need you would then have to count the number of values greater than zero across the items for each rating. So you could add a simple {=SUM(IF(CR:CR>0,1,0))} array formula for each rating in 5 blank cells to calculate.

Scott Holtzman Over a year ago

I am confused, how is what I did above different from what your last comment?

|

Gaffi · Accepted Answer · 2012-06-27 14:06:46Z

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.

Collectives™ on Stack Overflow

VBA - If Range Includes Value Then Array(i) = 1, Loop, Sum

2 Answers 2

7 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

7 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related