Multiple Worksheet_Change Functions

AmeliaBedelia

New Member
Joined
Apr 8, 2018
Messages
19
I found Worksheet_Change code that works like a charm for one row, but I want to be able to duplicate or run the code for multiples rows. What this code does is pops up a warning message stating "Only one entry allowed." and will not allow the user to enter in another entry until they clear out the previous entry in that same row. For example there are 5 rows of questions (F13:F17). In column G through I the user is able to select an 'x' from a data validation drop down list. I want this pop up to display if they try to select two 'x' in the same row. So for row 13 they select a response (x) in either G13, H13 or I13. The code below only allows them to select one 'x' in either G13, H13 or I13 and when they try to select a second option in these three cells it pops up the warning message.

I want to duplicate this code so that this happens in row 14-17. Each row is a separate question and needs to stand alone.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rLook As Range


Set rLook = Range("G13:I13")
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
If Intersect(Target, rLook) Is Nothing Then Exit Sub
If wf.CountA(rLook) < 2 Then Exit Sub
Application.EnableEvents = False
Target.ClearContents
MsgBox "Only one entry allowed"
Application.EnableEvents = True


End Sub


Hopefully I explained it well enough.
Thanks
 

Some videos you may like

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,521
Office Version
  1. 365
Platform
  1. Windows
Try
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim wf As WorksheetFunction
   
   Set wf = Application.WorksheetFunction
   If Intersect(Target, Range("G13:I17")) Is Nothing Then Exit Sub
   If wf.CountA(Range("G" & Target.Row).Resize(, 3)) < 2 Then Exit Sub
   Application.EnableEvents = False
   Target.ClearContents
   MsgBox "Only one entry allowed"
   Application.EnableEvents = True
End Sub
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,220
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
If there's a possibility that a user will attempt a paste to multiple rows that includes some or all of G13:I17, here's another version that clears offending rows one-at-a-time.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rLook As Range, Rw As Range
Set rLook = Range("G13:I17")
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
If Intersect(Target, rLook) Is Nothing Then Exit Sub
For Each Rw In rLook.Rows
    If wf.CountA(Rw) > 1 Then
        Application.EnableEvents = False
        Rw.ClearContents
        MsgBox "Only one entry allowed in range " & Rw.Address(0, 0)

    End If
Next Rw
Application.EnableEvents = True
End Sub
 

AmeliaBedelia

New Member
Joined
Apr 8, 2018
Messages
19
Thank you for such fast replies. I got it to work using the first code from Fluff.
JoeMo, I do not completely understand what you mean by a "possibility that the user will attempt a paste to multiple rows" - can you provide an example?
Just want to make if this relates to what I am building or not.
Thanks
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,220
Office Version
  1. 365
  2. 2010
Platform
  1. Windows

ADVERTISEMENT

Copy a pattern like the one below and paste it to G13.
Excel Workbook
STU
11xxx
12x
13xx
14x
15xxx
Sheet4
 

AmeliaBedelia

New Member
Joined
Apr 8, 2018
Messages
19
Okay, now I understand. My users would not have anything to copy from, so this should not be an issue. That being said I did copy a pattern like that into G13 and the message box still appeared stating they could not have more than one entry. Thanks so much to both of you - it works like a charm now!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,521
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,109,311
Messages
5,527,947
Members
409,794
Latest member
ajithppajith

This Week's Hot Topics

Top