Test if column has only one value?

[Djblois]

I have an idea that would allow me to do a lot of things in my add-in. I want to be able to test if a column consists of only one value. The only idea I have come up with sorts the column first and then tests the first value against the last value. Here is what it looks like:

Function fnTestColumnValue(ByVal lgColumnTest As Long) As Boolean

'Sort Range before testing for single value
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Cells(1, lgColumnTest), _
Order1:=xlAscending, Header:=xlYes
'Test the first value and the last value in the column to see if they are equal
If Cells(2, lgColumnTest).Value = Cells(finalrow(ActiveSheet) - 1, lgColumnTest).Value Then
fnTestColumnValue = True
End If

End Function

Is there a way to do this without sorting first? The reason why I am asking is because in some spots I will do about ten checks in a row and it might slow things down a bit.

[Bob Phillips]

Function fnTestColumnValue(ByVal lgColumnTest As Long) As Boolean
Dim mpLastRow As Long
Dim mpData As Range
Dim mpDataAddress As String

With ActiveSheet
mpLastRow = .Cells(.Rows.Count, lgColumnTest).End(xlUp).Row
Set mpData = .Cells(1, lgColumnTest).Resize(mpLastRow)
mpDataAddress = mpData.Address(False, False)
fnTestColumnValue = (.Evaluate("SUMPRODUCT((" & mpDataAddress & "<>"""")/" & _
"COUNTIF(" & mpDataAddress & "," & mpDataAddress & "&""""))") = _
mpData.Rows.Count)
End With

End Function

[Djblois]

Xld,

I am trying to learn so can you explain what these two lines do:

mpDataAddress = mpData.Address(False, False)
fnTestColumnValue = (.Evaluate("SUMPRODUCT((" & mpDataAddress & "<>"""")/" & _
"COUNTIF(" & mpDataAddress & "," & mpDataAddress & "&""""))") = _
mpData.Rows.Count)

[Bob Phillips]

What it is doing is counting the unique items within the range (the Evaluate("SUMPRODUCT ... bit). Rng.Rows.Count counts the total number of rows, if thewy are the same, there are no dups.

Actually reading this now, I see you asked for only one value so all you probably need is



Function fnTestColumnValue(ByVal lgColumnTest As Long) As Boolean
Dim mpLastRow As Long
Dim mpData As Range
Dim mpDataAddress As String

With ActiveSheet
mpLastRow = .Cells(.Rows.Count, lgColumnTest).End(xlUp).Row
Set mpData = .Cells(1, lgColumnTest).Resize(mpLastRow)
mpDataAddress = mpData.Address(False, False)
fnTestColumnValue = (.Evaluate("SUMPRODUCT((" & mpDataAddress & "<>"""")/" & _
"COUNTIF(" & mpDataAddress & "," & mpDataAddress & "&""""))") = 1)
End With

End Function

[Djblois]

xld,

I can't get this to work:

Function fnTestColumnValue(ByVal lgColumnTest As Long) As Boolean

Dim mpData As Range
Dim mpDataAddress As String

With ActiveSheet

Set mpData = .Cells(2, lgColumnTest).Resize(finalrow(wsWorking) - 1)
mpDataAddress = mpData.Address(False, False)
fnTestColumnValue = (.Evaluate("SUMPRODUCT((" & mpDataAddress & "<>"""")/" & _
"COUNTIF(" & mpDataAddress & "," & mpDataAddress & "&""""))") = 1)
End With

End Function

It doesn't crash; however, it isn't evaluating the expression correctly. When that range is filled with only one column then it is still coming up false. The range is the fifth column from the second row, since I have a column heading in the first row, to the last row - 1, since I have a total row.

I did find one problem. I was resizing by the size of the range so I now have this:

Function fnTestColumnValue(ByVal lgColumnTest As Long) As Boolean

Dim mpData As Range
Dim mpDataAddress As String

With wsWorking

Set mpData = .Range(Cells(2, lgColumnTest), _
Cells((finalrow(wsWorking) - 2), lgColumnTest))

mpDataAddress = mpData.Address(False, False)
fnTestColumnValue = (.Evaluate("SUMPRODUCT((" & mpDataAddress & "<>"""")/" & _
"COUNTIF(" & mpDataAddress & "," & mpDataAddress & "&""""))") = 1)
End With

End Function

Thank you,
Daniel

[Djblois]

Can someone help me?

[figment]

i am not completely sure what xld's equation is doing, but if you have blanks in the table, it might be messing up the comparison. and it seem to me that this would be more usefull if you passed a range to it rather then a column number. i will have to have a hack at it tommarow.

[gwkenny]

I understand the problem is: "I want to be able to test if a column consists of only one value."

The following will do that:


Function fnTestColumnValue(ByVal rngCol As Range) As Boolean

Dim rngTest As Range

Application.Volatile
Set rngTest = rngCol.EntireColumn

fnTestColumnValue = Application.WorksheetFunction.Max(rngTest) = Application.WorksheetFunction.Min(rngTest)

End Function



So let's say the column has just the number 4 in it. It will evaluate to true. If the column has TWO cells with the number 4 in it, it will still evaluate to true. This ignores text as you said "value". You didn't say if the "one value" could be repeated several times in the column or not.

Please NOTE that in my function, you pass a cell reference. Not a column number. :D

g-
gwkenny@yahoo.com
___________________________________
I need holiday money. Got any jobs, big or small, drop me a line! Thanks!

[Djblois]

That will work for my number columns but also how would I do it if it can be Numeric or Text?

Thank you for your help,
Daniel

P.S. Figment - I plan on changing it to where I pass a range, instead of a value but I wanted to get it work first. I know how to do that and will do that on my own when I am done.

[mikerickson]

=IF(COUNTIF(A:A,MAX(A:A))=COUNTA(A:A),"One","many")

=IF(COUNTIF(A:A,A1))=COUNTA(A:A),"One","many")

[Bob Phillips]

You must fully qualify everythgiung, you have Cells not dot qualified within a With.

And shouldn't you pass a column number to finlarow to get that row number?

On that basis, this worked for me



Function fnTestColumnValue(ByVal lgColumnTest As Long) As Boolean

Dim mpData As Range
Dim mpDataAddress As String

With wsWorking

Set mpData = .Range(.Cells(2, lgColumnTest), _
.Cells((finalrow(Sheet3, lgColumnTest) - 2), lgColumnTest))

mpDataAddress = mpData.Address(False, False)
fnTestColumnValue = (.Evaluate("SUMPRODUCT((" & mpDataAddress & "<>"""")/" & _
"COUNTIF(" & mpDataAddress & "," & mpDataAddress & "&""""))") = 1)
End With

End Function

Function finalrow(sh As Worksheet, col As Long) As Long
With sh
finalrow = .Cells(.Rows.Count, col).End(xlUp).Row
End With
End Function

[mikerickson]

Function fnTestColumnValue(ByVal lgColumnTest As Long) As Variant
Dim rowNum As Long
rowNum = 1
With Columns(lgColumnTest).Cells
On Error Resume Next
rowNum = .SpecialCells(xlCellTypeConstants).Row
rowNum = .SpecialCells(xlCellTypeFormulas).Row
On Error GoTo 0
End With
With Application
fnTestColumnValue = (.CountIf(Columns(lgColumnTest), Cells(rowNum, lgColumnTest)) = .CountA(Columns(lgColumnTest)))
End With
End Function