VBA - Problem Highlighting Duplicate Values

[beartooth91]

Sub Check_Duplicates3()
'
Dim ws As String, i As Long, FinalRow As Long, Main As Worksheet, rr As Range, r As Range

ws = InputBox(Prompt:="Enter the worksheet name to check", _

Title:="Enter Worksheet Name", Default:="AST")


Set Main = ThisWorkbook.Sheets(ws)

FinalRow = Main.Range("B" & Rows.Count).End(xlUp).Row

Set rr = Main.Range("B11:B" & FinalRow)


For Each r In rr

If WorksheetFunction.CountIf(rr, r.Value) > 1 Then

   r.EntireRow.Interior.ColorIndex = 6

   MsgBox ("You have duplicate point names. Please review the highlighted rows.")

Else

   MsgBox ("No duplicate point names found.")

   GoTo LastLine

End If

Next r

LastLine:

Main.Activate

End Sub

Stumped on this one! The idea is to check for and highlight Column B duplicate names in whatever sheet the user specifies.
It works perfectly when the Else block is NOT present.
When I include the Else block; it jumps right to that block, even if there are duplicate values.
Tried some different things with no success. I'm not sure what I'm doing wrong. Should be a standard If-Then-Else statement......?

---

​

 

[Fluff]

How about

Sub Check_Duplicates3()
'
Dim ws As String, i As Long, FinalRow As Long, Main As Worksheet, rr As Range, r As Range, c As Long

ws = InputBox(Prompt:="Enter the worksheet name to check", _
    Title:="Enter Worksheet Name", Default:="AST")


Set Main = ThisWorkbook.Sheets(ws)

FinalRow = Main.Range("B" & Rows.Count).End(xlUp).Row

Set rr = Main.Range("B11:B" & FinalRow)


For Each r In rr
    
    If WorksheetFunction.CountIf(rr, r.Value) > 1 Then
    
       r.EntireRow.Interior.ColorIndex = 6
    
       c = c = 1
    End If

Next r

If c > 0 Then
   MsgBox ("You have duplicate point names. Please review the highlighted rows.")
Else

   MsgBox ("No duplicate point names found.")

End If

Main.Activate

End Sub

 

[beartooth91]

How about

Sub Check_Duplicates3()
'
Dim ws As String, i As Long, FinalRow As Long, Main As Worksheet, rr As Range, r As Range, c As Long

ws = InputBox(Prompt:="Enter the worksheet name to check", _
    Title:="Enter Worksheet Name", Default:="AST")


Set Main = ThisWorkbook.Sheets(ws)

FinalRow = Main.Range("B" & Rows.Count).End(xlUp).Row

Set rr = Main.Range("B11:B" & FinalRow)


For Each r In rr
   
    If WorksheetFunction.CountIf(rr, r.Value) > 1 Then
   
       r.EntireRow.Interior.ColorIndex = 6
   
       c = c = 1
    End If

Next r

If c > 0 Then
   MsgBox ("You have duplicate point names. Please review the highlighted rows.")
Else

   MsgBox ("No duplicate point names found.")

End If

Main.Activate

End Sub

It works great if you change your line, above:

c = c = 1

to

c = c + 1

Thank You!
I understand why your version works.... I don't really understand why my version didn't work....?

 

[Fluff]

Your version will always fail if the first cell (ie B11) is not a duplicate, as the Else section tells it to exit the loop, so no other cells are checked.