• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

highlight duplicate entry

J

Juzar22

Member
I have VBA code to highlight duplicate entry , but this highlight also the number which is in hidden criteria , can you advice a new code,

below is the code required update

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  
  If Target.Row = 1 Then Exit Sub ' IF ITS A HEADER, DO NOTHING.
  
  On Error GoTo ErrHandler
  Application.ScreenUpdating = False
  
  Dim myDataRng As Range
  Dim cell As Range
  
  ' WE WILL SET THE RANGE (SECOND COLUMN).
  Set myDataRng = Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
  
  For Each cell In myDataRng
  cell.Offset(0, 0).Font.Color = vbBlack ' DEFAULT COLOR.
  
  ' LOCATE DUPLICATE VALUE(S) IN THE SPECIFIED RANGE OF DATA.
  If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
  cell.Offset(0, 0).Font.Color = vbRed ' CHANGE FORE COLOR TO RED.
  End If
  Next cell
  
  Set myDataRng = Nothing
ErrHandler:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub
 
Last edited by a moderator:
Can you please post a sample file as well as highlight what it is doing wrong ?
 
Hello Sir
Attached is the file , where you can see VBA code is running to highlight duplicate entry in column B , now B11 is highlighted red which is correct because number is repeated same in B3
Now also B12 is highlighted red , however the number is repeated but it is in hidden cell B4, so i want to exclude it. I mean hidden cell should not be picked as duplicate and should not be highlighted.
 

Attachments

  • Highlight Duplicate VBA.xls
    35.5 KB · Views: 14
try:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 Then Exit Sub            ' IF ITS A HEADER, DO NOTHING.
If Target.Column <> 2 Then Exit Sub
On Error GoTo ErrHandler
Application.ScreenUpdating = False

Dim myDataRng As Range
Dim cell As Range

' WE WILL SET THE RANGE (SECOND COLUMN).
Set myDataRng = Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
With myDataRng
  .Font.Color = vbBlack
  For Each cell In myDataRng
    If Not cell.EntireRow.Hidden Then
      If Len(cell.Value) > 0 Then
        Set zzz = .Find(cell.Value, , xlValues, xlWhole, , , , , False)
        If Not zzz Is Nothing Then
          myCount = 0
          myAddress = zzz.Address
          Do
            Set zzz = .FindNext(zzz)
            myCount = myCount + 1
          Loop While Not zzz Is Nothing And zzz.Address <> myAddress And myCount < 2
          If myCount > 1 Then cell.Font.Color = vbRed
        End If
      End If
    End If
  Next cell
End With

Set myDataRng = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Juzar22 said:
Thank You for reply
When i used your provided code It gives me error Wrong number arguments (.Find)
Click to expand...
try changing that line to:
Code: 
Set zzz = .Find(what:=cell.Value, LookIn:=xlValues, lookat:=xlWhole, searchformat:=False)
 
Juzar22 said:
Now its giving error Named Argument not found (Searchformat:=)
Click to expand...
Oh groan.. it's a Mac isn't it?
Just remove the last argument, either:
Set zzz = .Find(cell.Value, , xlValues, xlWhole)
or:
Set zzz = .Find(what:=cell.Value, LookIn:=xlValues, lookat:=xlWhole)
 
No its not Mac i am using Windows only but excel version is 2000
The first solution worked i.e Set zzz = .Find(cell.Value, , xlValues, xlWhole)
Thank you for your time
One last question the duplicate value is highlighted red i want to make complete cell highlighted to yellow (fill color) and font normal black color , see attached pic like in cell B4 and B12
ABC.jpg ABC.jpg
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 Then Exit Sub            ' IF ITS A HEADER, DO NOTHING.
If Target.Column <> 2 Then Exit Sub
On Error GoTo ErrHandler
Application.ScreenUpdating = False

Dim myDataRng As Range
Dim cell As Range

' WE WILL SET THE RANGE (SECOND COLUMN).
Set myDataRng = Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
With myDataRng
  .Interior.ColorIndex = xlNone
  For Each cell In myDataRng
    If Not cell.EntireRow.Hidden Then
      If Len(cell.Value) > 0 Then
        Set zzz = .Find(cell.Value, , xlValues, xlWhole)
        If Not zzz Is Nothing Then
          myCount = 0
          myAddress = zzz.Address
          Do
            Set zzz = .FindNext(zzz)
            myCount = myCount + 1
          Loop While Not zzz Is Nothing And zzz.Address <> myAddress And myCount < 2
          If myCount > 1 Then cell.Interior.ColorIndex = 6
        End If
      End If
    End If
  Next cell
End With

Set myDataRng = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Hello Sir , I have phone book in excel , Now when i search name it searches only first letter starting name but if i put any letter middle name then it doesn't search anything , can you change VBA code. example file is uploaded.

For example if i want to search John Estiva then the search only shows if we enter first starting word i.e John but if i put Estiva search not showing any result.
 

Attachments

  • Phonebook.xls
    261.5 KB · Views: 12
try changing:
Case "Surname"
For sat = 2 To Cells(65536, "b").End(xlUp).Row
Set deg1 = Cells(sat, "b")
If UCase(deg1) Like UCase(deg2) & "*" Then

to:
Case "Surname"
For sat = 2 To Cells(65536, "b").End(xlUp).Row
Set deg1 = Cells(sat, "b")
If UCase(deg1) Like "*" & UCase(deg2) & "*" Then
 
Hello Sir,

Regarding the same Phonebook.xls even after closing the form it stays open in system but physically i cannot see it, and whenever i want to open this file again it gives me message ''phonebook.xls is locked for editing'' so every time i have to kill the excel.exe process in task manager, is something wrong in VBA code, can you check and advice !!
 
Last edited:
That's because you mess with the Excel application's visibility; by default you make Excel invisible if macros are enabled while opening the file. The code behind the button to close the form does only that, it doesn't close the Excel application, or the workbook. It's a bit of a minefield, becase what if there are other workbooks open? You may not want to close the application, so that you can continue to work on your other workbooks, but you'll need to be able to see them, but if it's the only workbook you may want to close the application too. Certainly it can be coded for.
In the meantime, I'd make a simple change to this bit of code:
Code: 
Private Sub cmdClose_Click()
Unload Me
End Sub
to:
Code: 
Private Sub cmdClose_Click()
Unload Me
Application.Visible = True
End Sub
so that every time you close the form (with the button) it makes sure the application is visible.

Also, to handle someone closing the form with the X in the top right corner you need to add this to the userform's code-module:
Code: 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.Visible = True
End Sub
 
p45cal said:
That's because you mess with the Excel application's visibility; by default you make Excel invisible if macros are enabled while opening the file. The code behind the button to close the form does only that, it doesn't close the Excel application, or the workbook. It's a bit of a minefield, becase what if there are other workbooks open? You may not want to close the application, so that you can continue to work on your other workbooks, but you'll need to be able to see them, but if it's the only workbook you may want to close the application too. Certainly it can be coded for.
In the meantime, I'd make a simple change to this bit of code:
Code: 
Private Sub cmdClose_Click()
Unload Me
End Sub
to:
Code: 
Private Sub cmdClose_Click()
Unload Me
Application.Visible = True
End Sub
so that every time you close the form (with the button) it makes sure the application is visible.

Also, to handle someone closing the form with the X in the top right corner you need to add this to the userform's code-module:
Code: 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.Visible = True
End Sub
Click to expand...

Wow Sir Amazing solution, However if this only workbook should be close without opening the main file with close form click, is it possible ? otherwise this solution works great for me ..Thank You
 
Last edited:
Hi sir
I have this below code where i can highlight the active cell which works perfect but also i want to make the font bigger of active cell along with highlight , please add the code for me

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static rng As Range

    If Not rng Is Nothing Then rng.FormatConditions.Delete
    Set rng = Target
    With rng.FormatConditions.Add(Type:=xlExpression, Formula1:="=TRUE")
        .Interior.PatternColorIndex = xlAutomatic
        .Interior.Color = 49408
    End With
End Sub
 
You won't do this in conditional formatting.
You need to start a new thread as this is irrelevant to the topic of this one.
 
You must log in or register to reply here.
Back
Top