'================================================================================================
' Test if Multiple Cells are All Equal
' Compare a variable number of cells to see if they are all equal.
' Parameters
' pCells Variable number of cells to compare.
' Parameters can be single cells, ranges, or a mix.
' Returns "Equal" if all cells are equal.
' Returns the cell address of the first unequal cell.
' Returns a #VALUE! error if no parameters passed (EqualAll()).
' Returns "Equal" if passed a single cell.
' Returns a #VALUE! error if it encounters a null parameter before a unequal value.
' 08/23/24 Created to test ERA ratification dates.
'================================================================================================
Function EqualAll(ParamArray pCells() As Variant) As Variant
Dim value1 As Variant 'First value, all others compared to it
Dim cell As Range 'Next value in a range parameter
Dim i As Long 'Loop index
' Return #VALUE! error if no parameters are passed
If UBound(pCells) < 0 Then
EqualAll = CVErr(xlErrValue)
Exit Function
End If
' Load value1 with the first value
If TypeName(pCells(0)) = "Range" Then 'If it's a range parameter,
value1 = pCells(0).cells(1, 1).Value 'Get the first value
Else 'If it's a simple cell,
value1 = pCells(0) 'Get that value
End If
' Loop through all the parameters comparing them to the first one (value1)
' It will compare value1 to itself on the first iteration
' This is to avoid the range test on each loop
For i = LBound(pCells) To UBound(pCells)
If TypeName(pCells(i)) = "Range" Then 'If this parameter is a range,
For Each cell In pCells(i) 'Loop through the range
If cell.Value <> value1 Then 'If it's not a match,
EqualAll = cell.Address 'Return the cell address
Exit Function
End If
Next cell
Else 'If it's a simple cell
If pCells(i) <> value1 Then 'If it's not a match,
EqualAll = Application.Caller.Address 'Return the cell address
Exit Function
End If
End If
Next i
' Return "Equal" if all values match
EqualAll = "Equal"
End Function
