Macro Question/Support

Scott_86_

New Member
Hi,

On a worksheet I have 3 seperate ranges (J9:J28, U9:U28, J36:J55 = total 60 cells) where users can select from a drop down box either Y or N to poulate an indivudual cell.

I would like to have a limit of 30 Y's within the 60 cells. If someone would try and enter another Y after 30, this would not be permitted and a MsgBox would also come up with text.

Needs to be applied to all worksheets which are all identical.

This workbook already runs some macros and if someone could help me out with this that'd be great!

Ajesh

Active Member
Try this:

Code:
``````Private Sub Worksheet_Change(ByVal Target As Range)
Dim tRng As Range
Dim cell As Range
Dim vCount As Long

Application.EnableEvents = False

Set tRng = Application.Union(Range("J9:J28"), Range("U9:U28"), Range("J36:J55"))

vCount = 0
For Each cell In tRng
If cell.Value = "Y" Then vCount = vCount + 1
Next
If Not Intersect(Target, tRng) Is Nothing Then
If Target.Value = "Y" And vCount >= 30 Then
MsgBox "Only 30 Y allowed."
Application.Undo
End If
End If
Application.EnableEvents = True

End Sub``````

Scott_86_

New Member
Code:
``````Private Sub Worksheet_Change(ByVal Target As Range)
Dim tRng As Range
Dim cell As Range
Dim vCount As Long

Application.EnableEvents = False

Set tRng = Application.Union(Range("J9:J28"), Range("U9:U28"), Range("J36:J55"))

vCount = 0
For Each cell In tRng
If cell.Value = "Y" Then vCount = vCount + 1
Next
If Not Intersect(Target, tRng) Is Nothing Then
If Target.Value = "Y" And vCount >= 30 Then
MsgBox "Only 30 Y allowed."
Application.Undo
End If
End If
Application.EnableEvents = True

End Sub``````
Hi, the above code for my request at the start of the thread has been working excellent.

Is anyone able to help me out tweaking the code so that:
• *The text I currently have in the message box, I'll just use in the password box.*
• On entering the correct password, a 'Y' above the count of 30 (eg. 31)will be allowed.
• Once that extra 31st 'Y' is entered after inputting the correct password, the code will then revert to normal.
• So if someone were to try to enter a 32nd 'Y', the same password box would pop up. So on for 33rd, 34th, etc.

Ajesh

Active Member

Code:
``````Private Sub Worksheet_Change(ByVal Target As Range)
Dim tRng As Range
Dim cell As Range
Dim vCount As Long
Dim pWord As String

Application.EnableEvents = False

Set tRng = Application.Union(Range("J9:J28"), Range("U9:U28"), Range("J36:J55"))

vCount = 0
For Each cell In tRng
If cell.Value = "Y" Then vCount = vCount + 1
Next

If Not Intersect(Target, tRng) Is Nothing Then
If Target.Value = "Y" And vCount > 30 Then
inputpWord:
pWord = InputBox("Already 30 Y's entered. To enter Y's more than 30 please provide the magic word!", "Password Required!!!")
If StrPtr(pWord) = 0 Then   'If user clicks Cancel
Application.Undo
GoTo CleanExit
ElseIf pWord = "" Or Not pWord = "Open_Sesame" Then  'If user clicks ok with blank or incorrect password
GoTo inputpWord
End If
End If
End If
CleanExit:
Application.EnableEvents = True

End Sub``````
Thanks/Ajesh

Scott_86_

New Member
Ajesh,

Works great, thanks.