excelvba

VBA Loop through unique values in range based on criteria


As part of my project, I'm stuck with the following.

I need to be able to loop through each unique set of values in a Worksheet, where the criteria is met.

A B C
B1 UG Blue
B2 DG Blue
L1 Cell 1 Yellow
L2 Cell 1 Yellow
L3 Cell 2 Yellow
L4 Cell 2 Yellow
L5 Cell 3 Yellow
L6 Cell 3 Yellow
S1 River White

In VBA, I need to get the maximum number of rows where the value in Column C is Yellow.

I also need to be able to loop through each unique value in Column B, where the value in Column C is Yellow.

I think the first part can be achieved with the following:

MaxCells = WorksheetFunction.CountIfs(Worksheets("Location Groups").Range("C:C"), "Yellow")

I guess I then need to do a loop from 1 to MaxCells. But that loop then also needs to do something (for the sake of this example, it could just be a MsgBox with the unique cell value) based on each unique value in Column B where the value in Column C is also Yellow.

In conclusion, a loop with three iterations, because there are only three unique values (Cell 1, Cell 2 and Cell 3) which also match Yellow.


Solution

  • Using Collection is an option.

    Option Explicit
    Sub Demo()
        Dim objCol As New Collection, rngData As Range
        Dim i As Long, sKey
        Dim arrData
        Set rngData = Range("A1").CurrentRegion
        arrData = rngData.Value
        On Error Resume Next
        For i = LBound(arrData) + 1 To UBound(arrData)
            sKey = arrData(i, 3)
            If sKey = "Yellow" Then
                objCol.Add arrData(i, 2), CStr(arrData(i, 2))
            End If
        Next i
        On Error GoTo 0
        ' print to VBE Immediate Window, change to MsgBox if needed
        If objCol.Count = 0 Then
            Debug.Print "No matching vlaues"
        Else
            Debug.Print "Total Yellow: " & objCol.Count
            For Each sKey In objCol
                Debug.Print sKey ' print to VBE Immediate Window
                ' your code '
            Next
        End If
    End Sub