VBA: Check if cells in range contain same value and ignore blanks

[unknownymous]

Hi Gurus,

Good day!

I was looking for some codes on how to create a prompt if the data is not the same.

I saw this which is workable but I need to apply the condition that if the cell is blank, it should ignore it:

=========================================================
"= Existing Code from Source: VBA code - check if cells in range contain same value

Sub vv()
Dim rng As Range, v, cel As Range, x%
Set rng = Selection 'Change range as required
v = rng(1)
For Each cel In rng
If cel <> v Then
x = 1
Exit For
End If
Next
If x = 0 Then
'next step
Else: MsgBox "Not same"
End If
End Sub

=========================================================

Sample data:

Title	Name	Country
001	Marcus	AUS
002	Sean	US
001	Melody	AUS

Here: The macro should prompt and detect that the data is not the same for Title & Country Columns. Blank cells should be ignored.

Appreciate the help.

Cheers!

 

[Joe4]

If you simply want to take the current code and add a condition to the loop to check to make sure the value is not blank, then you can do this:

Sub vv()

    Dim rng As Range, v, cel As Range, x%

    Set rng = Selection 'Change range as required
    v = rng(1)

    For Each cel In rng
        If cell <> "" Then
            If cel <> v Then
                x = 1
                Exit For
            End If
        End If
    Next
    
    If x = 0 Then
        'next step
    Else: MsgBox "Not same"
    End If
    
End Sub

 

[unknownymous]

If you simply want to take the current code and add a condition to the loop to check to make sure the value is not blank, then you can do this:

Sub vv()

    Dim rng As Range, v, cel As Range, x%

    Set rng = Selection 'Change range as required
    v = rng(1)

    For Each cel In rng
        If cell <> "" Then
            If cel <> v Then
                x = 1
                Exit For
            End If
        End If
    Next
  
    If x = 0 Then
        'next step
    Else: MsgBox "Not same"
    End If
  
End Sub

Hey Joe! Thanks for sharing however in Column A, there are times that some rows are blank so I was hoping for some amendments. Appreciate the help.

I found this handy code but having problem ignoring the blank cells.

'Source: VBA code - check if cells in range contain same value
=====================
Sub vv()
Dim rng As Range, cel As Range
On Error Resume Next
Set rng = Range("A2:A" & Cells(Rows.Count, "A").End(3).Row).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
For Each cel In rng
If cel <> rng(1) Or cel(1, 2) <> rng(1, 2) Then
MsgBox cel.Address(0, 0) & " and/or " & cel(1, 2).Address(0, 0) & " is different."
cel.Select
Exit Sub
End If
Next
ActiveSheet.PrintPreview
End If
End Sub
=====================

Thanks!

 

[Joe4]

Did you try the code I posted, which was an amendment of your original code?

 

[unknownymous]

Did you try the code I posted, which was an amendment of your original code?

Yes, I received a compile error as Variable not defined

 

[Joe4]

Sorry, minor typo. Missed that the code originally only has one "l" in "cel" (not "cell").
So it should be:

Sub vv()

    Dim rng As Range, v, cel As Range, x%

    Set rng = Selection 'Change range as required
    v = rng(1)

    For Each cel In rng
        If cel <> "" Then
            If cel <> v Then
                x = 1
                Exit For
            End If
        End If
    Next
  
    If x = 0 Then
        'next step
    Else: MsgBox "Not same"
    End If
  
End Sub

 

[unknownymous]

Sorry, minor typo. Missed that the code originally only has one "l" in "cel" (not "cell").
So it should be:

Sub vv()

    Dim rng As Range, v, cel As Range, x%

    Set rng = Selection 'Change range as required
    v = rng(1)

    For Each cel In rng
        If cel <> "" Then
            If cel <> v Then
                x = 1
                Exit For
            End If
        End If
    Next
 
    If x = 0 Then
        'next step
    Else: MsgBox "Not same"
    End If
 
End Sub

Thank you!