Check non-continuous range for equal values

Question

Background

I'm trying to check equality between cells in an irregular, non-continuous range of cells. For this purpose I would like to know if all cells are equal to the first Cell in the Range. The Range can be anything, but let's say it could be the following (don't mind the implicit reference for now):

Range("A1:C1,F1,K1,X1,AA1")

---

Sample Code:

Because the Range is non-continuous, there is no way to use the COUNTIF as a WorksheetFunction, nor can I implement some sort of INDIRECT within Evaluate. So I was looking for the easiest way to do this. I came up with the following:

'Get a 1D-array from columns of interest
Dim arr As Variant: arr = Application.Index(Range("A1:AA1").Value, 1, Array(1, 2, 3, 6, 11, 24, 27))
'Join the 1D-array and check against 7* the value of A1
If Join(arr, "") = Replace("???????", "?", Range("A1").Value) Then
 Debug.Print "All equal to first cell"
Else
 Debug.Print "Not all equal to first cell"
End If

---

Question:

I've spent quite some time trying to come up with some code that would avoid iteration over the Range object's Cells (or iteration of any type), for example like below:

'Get dictionary ready
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
'Get range of cells
Dim rng As Range: Set rng = Range("A1:C1,F1,K1,X1,AA1")
'Iterate over cells
For Each cl In rng
 dict(cl.Value) = 1
Next cl
'Test for same values
If dict.Count = 1 Then
 Debug.Print "All equal to first cell"
Else
 Debug.Print "Not all equal to first cell"
End If

It has also become clear to me that there is no simple COUNTIF of an Array. And also something like Filter has proven to not be "error" proof.

While this is working code, I was hoping to find out the best way to know if all values in an irregular, non-continuous range of cells are the same. And therefor hope CR is the right place to ask.

Answer 1

Since, there is an array of values, no need to iterate in the range, I think. Why not iterating between the array elements?

Dim arr As Variant, sh As Worksheet, El As Variant
Dim refVal As Variant, boolWrong As Boolean, strDif As String
 Set sh = ActiveSheet
 arr = Application.Index(sh.Range("A1:AA1").Value, 1, Array(1, 2, 3, 6, 11, 24, 27))
 refVal = arr(1)
 For Each El In arr
 If El <> refVal Then
 boolWrong = True
 strDif = El
 Exit For
 End If
 Next
If boolWrong Then
 Debug.Print "Not all equal to first cell" & vbCrLf & _
 strDif & " instead of " & refVal
Else
 Debug.Print "All equal to first cell"
End If

• JvdV: Thanks for your contribution @FaneDuru. Indeed, iteration through memory is faster in general. So this would avoid the Range object. It's good practice.

Answer 2

Using a Dictionary to count the occurences of a single value is overkill. If the question was count the number of values that match the first then If FirstValue = cl.Value Then Count = Count + 1 would be far more efficient than using a Dictionary.

I would like to know if all cells are equal to the first Cell in the Range

It seems to me that you are over complicating things. Based on the objective above we are looking for a simple True or False answer. Currently, you have to iterate over all the cells before you can determine whether all the cell value match. So it takes the same amount of time whether all cells match or not. It would be far better to set a flag and exit the loop when a unmatched value is found.

'Get range of cells
Dim rng As Range
Set rng = Range("A1:C1,F1,K1,X1,AA1")
Dim Value As Variant
Value = rng.Cells(1, 1).Value
Dim flag As Boolean
For Each cl In rng
 If cl.Value <> Value Then
 flag = True
 Exit For
 End If
Next cl
'Test for same values
If Not flag Then
 Debug.Print "All equal to first cell"
Else
 Debug.Print "Not all equal to first cell"
End If

• JvdV: That would indeed be overkill, good call. I added the example because I would like to avoid such iteration over the Range completely. Dictionary is used because in the back of my head I was probably thinking about how to count unique values in an irregular non-continuous range. For this purpose your solution would definitely be the better oner one. Thank you for your answer.

Answer 3

It is possible to combine Application.Find with Application.Sum (arr2 in the code below) on the extracted array (arr in the code) to get the same result as Countif. The reason is that Application.Find returns an array filled with 1 if the value is found in the corresponding element (See picture below.)

enter image description here

But Application.Find will return false positives if the first cell is empty (Vide here.) enter image description here

And Application.Sum will return an error if one of the elements is different from the first one. enter image description here

Beside that, the number of times the value of the first cell is found should match the number of elements of the array (7 in this case.)

Here is the code:

Option Explicit
Sub CountIfCodeReview235075()
 Dim arr As Variant, arr2 As Variant
 With ActiveSheet.Range("A1:AA1")
 'Get a 1D-array from columns of interest
 arr = Application.Index(.Value2, 1, Array(1, 2, 3, 6, 11, 24, 27))
 End With
 If Not IsEmpty(arr(1)) Then
 With Application
 arr2 = .Find(arr(1), arr)
 Select Case True
 Case IsError(.Sum(arr2))
 Debug.Print "Not all equal to first cell"
 Case .Sum(arr2) <> UBound(arr)
 Debug.Print "Not all equal to first cell"
 Case Else
 Debug.Print "All equal to first cell"
 End Select
 End With
 End If
End Sub

• JvdV: Thanks for that valuable insight. In terms of which is the "better" method it's hard to tell. Maybe a matter of personal preference? Either way, upvoted for the technique used as this comes close to the COUNTIF approach that would avoid iteration in a continuous range. =)
• JvdV: Found a way to utilize Application.Match with Application.Count to not have to deal with false positives or IsError
• user215992: @JvdV That's nice!

Answer 4

I think I found a solution that seemed the most elegant:

Sub Test()
'Get a 1D-array from columns of interest
Dim arr As Variant: arr = Application.Index(Range("A1:AA1").Value, 1, Array(1, 2, 3, 6, 11, 24, 27))
'Check if all elements in array match the first element
With Application
 If .Count(.Match(arr, Array(arr(1)), 0)) = 7 Then
 Debug.Print "All equal to first cell"
 Else
 Debug.Print "Not all equal to first cell"
 End If
End With
End Sub

So effectively; Application.Count and Application.Match work together to replace the WorksheetFunction.CountIf quite seamlessly on any irregular non-continuous range. And therefor we prevent any iteration.

This would however not take into consideration exact matches (not case-sensitive). For that I would revert back to my initial attempt.