Highlight / warn when a value is entered again in the same row?

[rjn008]

Hello there, I am a newbie. I am a good excel user but not a good VBA or any language writer/programmer.

I want to create a VB script so that the below when entered into the cell on the same row, if it already exists to highlight this and a pop up warning if possible, to either accept and continue so it highlights or to have the option of not accepting the entry? Is this possible?

So on row 5 where Orange has been entered for a 2nd time, this is when I would like the VB to kick in, it could be on any row and any column? I use a data validation list view on each cell from the cells B20:B30 - can obviously vary, smaller or longer.

This is the mini sheet for you to help with;

Book1.xlsx
	A	B	C	D
1	Test	21/04/2023	25/04/2023	29/04/2023
2
3	7	7	7	1
4	Name	Week 1	Week 2	Week 3
5	A	White	Orange	Orange
6	B	Orange	Blue
7	C	Yellow	Red
8	D	Blue	Black
9	E	Red	Black
10	F	Purple	Pink
11	G	Black	Yellow
12
13
14
15
16
17
18
19
20		White
21		Orange
22		Yellow
23		Blue
24		Red
25		Purple
26		Black
27		Pink
28		Green
29		Violet
30		Plum
Sheet1

Cell Formulas
Range	Formula
A3	A3	=COUNTA(A5:A21)
B3:D3	B3	=COUNTA(B5:B11)

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A1:H11	Expression	=ROW(A1)=CurrentRow	text	NO

Cells with Data Validation
Cell	Allow	Criteria
B5:D11	List	=$B$20:$B$30

 

[Snakehips]

@rjn008 Welcome to MrExcel.

Maybe give this a try. Copy /paste code into the sheet's code module within the VB editor.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Rng As Range

'Dont apply code if it is a change to more than just a single cell
If Target.Cells.Count > 1 Then Exit Sub

'determine changed cell ,'Target', is within sensible range of interest
If Not Intersect(Target, Range("B3:AZ15")) Is Nothing Then  '<< ????? Edit range to suit


    Set Rng = Range(Target.EntireRow.Address)   'Rng set to Target row
    
    If Application.WorksheetFunction.CountIf(Rng, Target) > 1 Then   ' check for duplicate entry in row
           
                Rng.Interior.ColorIndex = 3  'if duplicate, hidhlight row red
         'display message andawait response
       Resp = MsgBox("Do you wish to keep this duplicate enty?", vbYesNo, "DUPLICATE ENTRY!!!")
                
               
               If Not Resp = vbYes Then   'If response is No then
                Application.EnableEvents = False  'Disable event handling otherwise this event will  call itself again
                
                    Target.ClearContents   'clear the Target entry
                     Target.Select  're-select the Target cell forpossible re-entry
                     
                  Application.EnableEvents = True  're-establish event handling
                End If
      'In any event, clear the red highlight
      Rng.Interior.ColorIndex = xlColorIndexNone
      
      
    End If
End If
End Sub

Hope that helps.

 

[rjn008]

@rjn008 Welcome to MrExcel.

Maybe give this a try. Copy /paste code into the sheet's code module within the VB editor.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Rng As Range

'Dont apply code if it is a change to more than just a single cell
If Target.Cells.Count > 1 Then Exit Sub

'determine changed cell ,'Target', is within sensible range of interest
If Not Intersect(Target, Range("B3:AZ15")) Is Nothing Then  '<< ????? Edit range to suit


    Set Rng = Range(Target.EntireRow.Address)   'Rng set to Target row
   
    If Application.WorksheetFunction.CountIf(Rng, Target) > 1 Then   ' check for duplicate entry in row
          
                Rng.Interior.ColorIndex = 3  'if duplicate, hidhlight row red
         'display message andawait response
       Resp = MsgBox("Do you wish to keep this duplicate enty?", vbYesNo, "DUPLICATE ENTRY!!!")
               
              
               If Not Resp = vbYes Then   'If response is No then
                Application.EnableEvents = False  'Disable event handling otherwise this event will  call itself again
               
                    Target.ClearContents   'clear the Target entry
                     Target.Select  're-select the Target cell forpossible re-entry
                    
                  Application.EnableEvents = True  're-establish event handling
                End If
      'In any event, clear the red highlight
      Rng.Interior.ColorIndex = xlColorIndexNone
     
     
    End If
End If
End Sub

Hope that helps.

Thank you, on my dummy data that works, on my actual data I have this bit of code in. So do I just put the code above in the same VB box or if not please advise?

 

[Snakehips]

Yes, I would say so. They relate to different worksheet events.

Test it on a backed-up copy.

 

[rjn008]

Yes, I would say so. They relate to different worksheet events.

Test it on a backed-up copy.

@Snakehips yes I have it working many thanks! The only thing is your highlight rule doesn't work as I have my current row highlight rule in place. But the warning box appears which is as useful.

 

[rjn008]

Morning @Snakehips - On the rule are you able to set up so that if you accept the entry it just highlights the cell rather than the row?

Presume the 'EntireRow' needs change but does just putting 'Cell' in there work?

 

[rjn008]

And keep the cell highlighted is what I mean even if you select another cell, so it stands out on the sheet?

 

[Snakehips]

Morning
The code still needs to set 'Rng'as the entire row so that the COUNTIF function will work as number of entries in the row expands.
'Target' is the variable that is auto-designated for the triggering range of event handling code so you now need the highlighting part of your code to apply to Target.

Try the revision below.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Rng As Range

'Dont apply code if it is a change to more than just a single cell
If Target.Cells.Count > 1 Then Exit Sub

'determine changed cell ,'Target', is within sensible range of interest
If Not Intersect(Target, Range("B3:AZ15")) Is Nothing Then  '<< ????? Edit range to suit


    Set Rng = Range(Target.EntireRow.Address)   'Rng set to Target row
    
    If Application.WorksheetFunction.CountIf(Rng, Target) > 1 Then   ' check for duplicate entry in row
           
                Target.Interior.ColorIndex = 3  'if duplicate, hidhlight CELL red
         'display message andawait response
       Resp = MsgBox("Do you wish to keep this duplicate enty?", vbYesNo, "DUPLICATE ENTRY!!!")
                
               
               If Not Resp = vbYes Then   'If response is No then
                Application.EnableEvents = False  'Disable event handling otherwise this event will  call itself again
                
                    Target.ClearContents   'clear the Target entry
                    Target.Interior.ColorIndex = xlColorIndexNone 'clear the highlight
                     Target.Select  're-select the Target cell forpossible re-entry
                     
                  Application.EnableEvents = True  're-establish event handling
                End If

      'If response is Yes then do nothing and the duplicate cell will remain highlighted
            
    End If
End If
End Sub

 

[rjn008]

Cheers @Snakehips that's worked for me!

 

[rjn008]

Morning @Snakehips - if I wanted to create the same warnings but down a column rather than across a row, what part of the code would need changing?

I presume this but change to something Column named?