• 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.

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!
 
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
 
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:
  • A password box pops up instead of a message box.
    • *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.
Thanks in advance!
 
Hi Scott, Try this. Replace "Open_Sesame" with your password.

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
            MsgBox "Oops! Password entered is incorrect. Please enter correct Password.", vbCritical, "Incorrect Password!!!"
            GoTo inputpWord
        End If
    End If
End If
CleanExit:
Application.EnableEvents = True

End Sub

Thanks/Ajesh
 
Back
Top