macro code to get dynamic range

[ashish128]

Hi Friends,

I am trying to write a macro to find if a range consists of same
values or not
Eg
A1 A1
A1 A1
A1 A1
A1 A1
A1 A2
A1 A1
Yes No <--This is formula result

The formula is =sumproduct(--("A1"<>range))

The problem is that though the column number is fixed (say A) but the
number of values it has (i.e. the number of rows it extends to) is not
the same everytime. I want to get this range through macro so as to
feed it to the function.

Is there a way to find the range as a result of continous filled cells

My data is in cell A2 and extends below (No spaces / blank cells in
between).

Kindly help.

With Regards,

Ashish

 

[Bob Phillips]

=IF(COUNTIF(A:A,A1)=COUNT(A:A),"Yes","No")

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[ashish128]

=IF(COUNTIF(A:A,A1)=COUNT(A:A),"Yes","No")

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)














- Show quoted text -

Thanks for the help,

Sorry your formula didnt worked but it founded the base for my formula
which is working for me.
=COUNTIF(A:A,"<>A1")-COUNTIF(A:A,"<>"&"*")

This formula gives me output as "Zero" if all value in column are same
excluding the blank cells and "Non-Zero" if any other values are there
in the column excluding the blank cells

Thanks again

With Regards,

Ashish

 

[Guest]

Ashish,

here is another solution you might be interested in, using a function that
can be used for any range.

Public Function UniqueValues(ByVal area As range) As String
Dim cell As range
Dim col As New Collection

' add each item to the collection. If item is already in the collection
' an error is raised, which we simply ignore.
On Error Resume Next
For Each cell In area
col.Add cell.Value, CStr(cell.Value)
Next
On Error GoTo 0

' if all items were the same, then collection has only one item, ie,
count = 1.
' if the area included different values, then the count will be > 1.
If col.Count = 1 Then
UniqueValues = "Yes"
Else
UniqueValues = "No"
End If
End Function


In any cell that you would like to report results enter:

=UniqueValues(a1:a4)

assuming your data is is A1:A4. This will report "Yes" or "No", depending on
contents of A1:A4.

Cheers,
Socratis