Looking for VBA to check if all data in a column is the same (text)

[fife8]

Looking for VBA to check if all data in a column is the same (text) -

For example - if I did it manually -top row cell 1 would contain" '=IF(AND(B1=B2,B2=B3,B3=B4,B4=B5,B5=B6,B6=B7,B7=B8,B8=B9),TRUE,FALSE)

But ideally I need this to just loop thru and check that all cols contain same text - for entire range (lets say 300 columns maybe).

Example data set - and somehow column C would get flagged with a difference (pop up OR text somewhere):
A B C
[TABLE="width: 144"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]cat[/TD]
[TD]dog[/TD]
[TD]ball[/TD]
[/TR]
[TR]
[TD]cat[/TD]
[TD]dog[/TD]
[TD]ball[/TD]
[/TR]
[TR]
[TD]cat[/TD]
[TD]dog[/TD]
[TD]bat[/TD]
[/TR]
</tbody>[/TABLE]

I have seen several suggestions for how to do this with numbers, some at a row level -but not text within a column in same sheet.

History = I have 5 sheets or so in a workbook - I want to check that the header row for EACH sheet is all the same. So I just grabbed those headers to a new cheat similar to above..


Thanks in advance.

 

[Joe4]

You can use COUNTA (which counts all blank entries), and compare it to COUNTIF, seeing how many entries match the first cell.
If they are all the same, those two values will be equal.

Here is a little example of how you can code that:

Sub Check()

    Dim myRange As Range
    Dim myValue
    Dim allSame As Boolean
    
'   Set column to check
    Set myRange = Range("C:C")
    
'   Get first value from myRange
    myValue = myRange(1, 1).Value
    
    allSame = (WorksheetFunction.CountA(myRange) = WorksheetFunction.CountIf(myRange, myValue))
    
'   Return whether or not they are all the same (TRUE/FALSE)
    MsgBox allSame
    
End Sub

You could also make this a function, if you like, if you need to repeat use of it and do not want to repeat the code every time.

 

[fife8]

Is there a way to loop thru all the cols without specifying each one?

You can use COUNTA (which counts all blank entries), and compare it to COUNTIF, seeing how many entries match the first cell.
If they are all the same, those two values will be equal.

Here is a little example of how you can code that:

Sub Check()

    Dim myRange As Range
    Dim myValue
    Dim allSame As Boolean
    
'   Set column to check
    Set myRange = Range("C:C")
    
'   Get first value from myRange
    myValue = myRange(1, 1).Value
    
    allSame = (WorksheetFunction.CountA(myRange) = WorksheetFunction.CountIf(myRange, myValue))
    
'   Return whether or not they are all the same (TRUE/FALSE)
    MsgBox allSame
    
End Sub

You could also make this a function, if you like, if you need to repeat use of it and do not want to repeat the code every time.

 

[Joe4]

OK, first we convert the calculation to a function, so we can easily re-use it, like this:

Function AllSame(myRange As Range) As Boolean

    Dim myValue
   
'   Get first value from myRange
    myValue = myRange(1, 1).Value
    
    AllSame = (WorksheetFunction.CountA(myRange) = WorksheetFunction.CountIf(myRange, myValue))
    
End Function

Then, we can set up a loop to loop through all the columns, and return the result for each to a message box, like this:

Sub MyTest()

    Dim cn As Long
    Dim cArr
    Dim cl As String
    Dim rng As Range
    Dim res As Boolean
    
'   Loop through all column numbers (A=1, B=2, C=3, ...)
    For cn = 1 To 3
'       Convert column number to column letter
        cArr = Split(Cells(1, cn).Address(True, False), "$")
        cl = cArr(0)
'       Set range for column
        Set rng = Range(cl & ":" & cl)
'       Call function and get value
        res = AllSame(rng)
'       Return message box to screen
        MsgBox "Column " & cl & ": " & res
    Next cn
    
End Sub

 

[fife8]

Thanks for the response, I think perhaps I am not calling the correct sheet- as I am not getting a popup when I have forced a difference similar to example above.
I tried doing the following = where my sheet name is HeaderCheck. Perhaps I need to then say ws.Cells when converting?

Sub MyTest()

    Dim cn As Long
    Dim cArr
    Dim cl As String
    Dim rng As Range
    Dim res As Boolean
Set ws = wb.Sheets("HeaderCheck")
'   Loop through all column numbers (A=1, B=2, C=3, ...)
    For cn = 1 To 1000
'       Convert column number to column letter
        cArr = Split(Cells(1, cn).Address(True, False), "$")
        cl = cArr(0)
'       Set range for column
        Set rng = Range(cl & ":" & cl)
'       Call function and get value
        res = AllSame(rng)
'       Return message box to screen
        MsgBox "Column " & cl & ": " & res
    Next cn
    
End Sub

OK, first we convert the calculation to a function, so we can easily re-use it, like this:

Function AllSame(myRange As Range) As Boolean

    Dim myValue
   
'   Get first value from myRange
    myValue = myRange(1, 1).Value
    
    AllSame = (WorksheetFunction.CountA(myRange) = WorksheetFunction.CountIf(myRange, myValue))
    
End Function

Then, we can set up a loop to loop through all the columns, and return the result for each to a message box, like this:

Sub MyTest()

    Dim cn As Long
    Dim cArr
    Dim cl As String
    Dim rng As Range
    Dim res As Boolean
    
'   Loop through all column numbers (A=1, B=2, C=3, ...)
    For cn = 1 To 3
'       Convert column number to column letter
        cArr = Split(Cells(1, cn).Address(True, False), "$")
        cl = cArr(0)
'       Set range for column
        Set rng = Range(cl & ":" & cl)
'       Call function and get value
        res = AllSame(rng)
'       Return message box to screen
        MsgBox "Column " & cl & ": " & res
    Next cn
    
End Sub

 

[Joe4]

Note that this line by itself:

Set ws = wb.Sheets("HeaderCheck")

Really adds nothing of value to the macro.
Setting a worksheet variable like that does NOT actually select that worksheet.
You would either then need to preface each range after that with a "ws.", or add a line like:

ws.Select

Also, you need to define "wb". You are trying to use it here, but haven't set it equal to anything.

I would also highly recommend you use the "Option Explicit" command at the top of your code, to force yourself to declare all variables.
It helps greatly in debugging, and also helps prevent typos.
See: http://www.excel-easy.com/vba/examples/option-explicit.html

 

[fife8]

Thanks- sorry - I do set the wb at the very top As Workbook. I was wondering how to specifically alter your code such that it specifically looks in Sheet HeaderCheck. As I was not getting a message box saying there was an issue - when I manually set one.

I will look into option explicit link-thanks!

 

[Joe4]

You only did half the job. You set a variable for it (ws), but then you didn't do anything with it.

As I mentioned previously, you have two choices.

1. You can either put "ws." in front of every reference to "Range" or "Cell", i.e.
cArr = Split(ws.Cells(1, cn).Address(True, False), "$")
Set rng = ws.Range(cl & ":" & cl)
etc.

- or -

2. Simply put this line before the loop:
Sheets("HeaderCheck").Activate

 

[fife8]

@Joe4 -- thanks for the code. Right now, if I have 100 columns - the true/false box will pop up 100x. Is there any way to have it so I get a popup ONLY if there is a False column mismatch only?

I have 5 Rows- but could have up to 100 or so columns (possibly more). This is more of a fail safe to make sure all the headers in my sheets are equal. So it should* be a rare occurrence that a message should say...something is wrong.

So back to my sample - I would really only need 1 pop up that says Not all rows within columns have equal values:

A B C
[TABLE="class: cms_table, width: 144"]
<tbody>[TR]
[TD]cat[/TD]
[TD]dog[/TD]
[TD]ball[/TD]
[/TR]
[TR]
[TD]cat[/TD]
[TD]dog[/TD]
[TD]ball[/TD]
[/TR]
[TR]
[TD]cat[/TD]
[TD]dog[/TD]
[TD]bat


[/TD]
[/TR]
</tbody>[/TABLE]



thanks
Cathy

 

[Joe4]

Just put the MsgBox in an IF statement, i.e.

If res = False Then MsgBox "Column " & cl & " is not all the same!"