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.

  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


  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


    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

    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
    If Not Intersect(Target, tRng) Is Nothing Then
        If Target.Value = "Y" And vCount >= 30 Then
            MsgBox "Only 30 Y allowed."
        End If
    End If
    Application.EnableEvents = True

    End Sub

Share This Page