1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. 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...

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

Discussion in 'VBA Macros' started by Scott_86_, Dec 4, 2018.

  1. Scott_86_

    Scott_86_ New Member

    Messages:
    10
    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!
  2. Ajesh

    Ajesh Active Member

    Messages:
    183
    Try this:

    Code (vb):

    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
     
  3. Scott_86_

    Scott_86_ New Member

    Messages:
    10
    Code (vb):

    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!
  4. Ajesh

    Ajesh Active Member

    Messages:
    183
    Hi Scott, Try this. Replace "Open_Sesame" with your password.

    Code (vb):

    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
    Scott_86_ likes this.
  5. Scott_86_

    Scott_86_ New Member

    Messages:
    10
    Ajesh,

    Works great, thanks.
    Ajesh likes this.

Share This Page