Macro Question/Support

[scott_86_]

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 aplied 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!

 

[mrshl9898]

Hi,

Try this, it will need to be added to the sheets (not in a module)

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim KeyCells As Range
    Dim myrange As Range
    Dim myrange2 As Range
    Dim myrange3 As Range
    
    Set myrange = Range("J9:J28")
    Set myrange2 = Range("U9:U28")
    Set myrange3 = Range("J36:J55")
    Set KeyCells = Range("J9:U55")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

    If Application.CountIf(myrange, "Y") + Application.CountIf(myrange2, "Y") + Application.CountIf(myrange3, "Y") > 30 Then
    With Application
        .EnableEvents = False
        .Undo
        .EnableEvents = True
    End With
    MsgBox "Limit Exceeded"
    End If

    End If
    
End Sub

 

[scott_86_]

Hi,

Try this, it will need to be added to the sheets (not in a module)

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim KeyCells As Range
    Dim myrange As Range
    Dim myrange2 As Range
    Dim myrange3 As Range
    
    Set myrange = Range("J9:J28")
    Set myrange2 = Range("U9:U28")
    Set myrange3 = Range("J36:J55")
    Set KeyCells = Range("J9:U55")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

    If Application.CountIf(myrange, "Y") + Application.CountIf(myrange2, "Y") + Application.CountIf(myrange3, "Y") > 30 Then
    With Application
        .EnableEvents = False
        .Undo
        .EnableEvents = True
    End With
    MsgBox "Limit Exceeded"
    End If

    End If
    
End Sub

Hi mlrshl,

Thank you.

That worked fine when I applied in to an individual worksheet.

Is there any chance you could tweak it so I can put the code into 'ThisWorkbook' so it applies to all worksheets?

Thanks

 

[mrshl9898]

Your welcome.

Sorry, I haven't seen any way to do that.

 

[Fluff]

Simply copy the code & pout it into a

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

event, in the ThisWorkbook module