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.
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