Msg box when a cell value changes to >1

[TODDLL]

I would like a msg box to pop up if a cell's value is >1 In the table below as an example, If one of the people have a result entered more than once from Jan through Apr, I would like a pop up stating that there can only be 1 entry between Jan and April. The count column counts the cells if there is a value entered. I would like to apply this to a table that has 100 rows. The way I envision this working is if the user enters a second number in one of column cells, that a message will pop up when they hit enter. I have not worked with a msg box applied to a range of cells. I would surely appreciate help on this. Thank you.

Book1.xlsx
	C	D	E	F	G	H
5		JAN	FEB	MAR	APR	COUNT
6	JOHN	1.24				1
7	JIM		1.7		1.3	2
8	SAM			2.5		1
9	MIKE	2.3	2.6			2
10	KIM				2.4	1
11	SALLY			2.1		1
Sheet1

Cell Formulas
Range	Formula
H6:H11	H6	=COUNT(D6:G6)

 

[aRandomHelper]

Try something like this. Put it into the worksheet's code (Right click sheet name at the bottom -> View Code)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("D:G")) Is Nothing Then
        If Application.CountA(Range("D" & Target.Row & ":G" & Target.Row)) > 1 Then
            MsgBox "Only 1 entry allowed between Jan and Apr"
            Application.Undo ' Undo last entry, remove if not needed
        End If
    End If
End Sub

 

[TODDLL]

Excellent! Even more than I had hoped for by undoing the entry. Now, how do I expand that so that it does the same for May through August, and September through December?

 

[aRandomHelper]

Duplicate the If block, adjust the columns and message accordingly

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("D:G")) Is Nothing Then
        If Application.CountA(Range("D" & Target.Row & ":G" & Target.Row)) > 1 Then
            MsgBox "Only 1 entry allowed between Jan and Apr"
            Application.Undo ' Undo last entry, remove if not needed
        End If
    End If
    If Not Intersect(Target, Columns("H:K")) Is Nothing Then '<-- adjust columns
        If Application.CountA(Range("H" & Target.Row & ":K" & Target.Row)) > 1 Then '<-- adjust columns
            MsgBox "Only 1 entry allowed between May and Aug"
            Application.Undo ' Undo last entry, remove if not needed
        End If
    End If
End Sub

 

[TODDLL]

You have been very helpful. Thank you so much for the quick answers.

 

[TODDLL]

Just when I think I have it all figured out, I realized that I forgot to consider another factor. If the person has an "A" in the TYPE column, they can only have one entry in the 4 month period, however, if the person has a "B" in the TYPE column, they can have multiple entries during the 4 month period. Can that be worked into the vba code?

	TYPE	JAN	FEB	MAR	APR	COUNT
JOHN	A	1.24				1
JIM	A		1.7		1.3	2
SAM	B			2.5		1
MIKE	B	2.3	2.6			2
KIM	A				2.4	1
SALLY	B			2.1		1

 

[aRandomHelper]

Just add in a new condition, assuming that's on column B.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("D:G")) Is Nothing Then
        If Range("B" & Target.Row).Value = "A" Then
            If Application.CountA(Range("D" & Target.Row & ":G" & Target.Row)) > 1 Then
                MsgBox "Only 1 entry allowed between Jan and Apr"
                Application.Undo ' Undo last entry, remove if not needed
            End If
        End If
    End If
    If Not Intersect(Target, Columns("H:K")) Is Nothing Then '<-- adjust columns
        If Range("B" & Target.Row).Value = "A" Then
            If Application.CountA(Range("H" & Target.Row & ":K" & Target.Row)) > 1 Then '<-- adjust columns
                MsgBox "Only 1 entry allowed between May and Aug"
                Application.Undo ' Undo last entry, remove if not needed
            End If
        End If
    End If
End Sub

 

[TODDLL]

Thank you so much! This is perfect. Have a great evening.