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

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

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

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

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

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

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.