How can I make a loop to run this code 15 times using a list of the range variables I defined?

I am running the same code for each of 15 static Ranges on the (current) Worksheet_Change event. Each range is evaluated by itself. I am checking for duplicates, but not across ranges, only in each individual range. But all ranges must be checked (or up until action) before the procedure ends. The cells are being filled by user selections from dynamic drop down lists for all cells.

The code I am posting works just as I need it to. How can I make a loop to run the same code 15 times using a list of the range variables I defined?

I want to simplify the code so that if I make a change to the code I don't have to change it in 15 places.

I have tried several versions of researched code to make a looping code functional, but the multiple If statements make it hard for me to find the right structure for a loop. I finally gave up and copied the code 15 times in an If - ElseIf statement which works.

Private Sub Worksheet_Change(ByVal Target As Range)
'Define your variables.

Dim Sun1AM As Range, Sun1PM As Range, Wed1PM As Range

Dim Sun2AM As Range, Sun2PM As Range, Wed2PM As Range

Dim Sun3AM As Range, Sun3PM As Range, Wed3PM As Range

Dim Sun4AM As Range, Sun4PM As Range, Wed4PM As Range

Dim Sun5AM As Range, Sun5PM As Range, Wed5PM As Range
'Set the ranges where you want to prevent duplicate entries.

Set Sun1AM = Range(“C4:C14”)

Set Sun1PM = Range(“C17:C21”)

Set Wed1PM = Range(“C24:C28”)

Set Sun2AM = Range(“E4:E14”)

Set Sun2PM = Range(“E17:E21”)

Set Wed2PM = Range(“E24:E28”)

Set Sun3AM = Range(“G4:G14”)

Set Sun3PM = Range(“G17:G21”)

Set Wed3PM = Range(“G24:G28”)

Set Sun4AM = Range(“I4:I14”)

Set Sun4PM = Range(“I17:I21”)

Set Wed4PM = Range(“I24:I28”)

Set Sun5AM = Range(“K4:K14”)

Set Sun5PM = Range(“K17:K21”)

Set Wed5PM = Range(“K24:K28”)
'See if target is in any of the ranges defined above and check for

'duplicates range by range.

If Not Intersect(Target, Sun1AM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Sun1AM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Sun1PM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Sun1PM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Wed1PM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Wed1PM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Sun2AM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Sun2AM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Sun2PM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Sun2PM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Wed2PM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Wed2PM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Sun3AM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Sun3AM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Sun3PM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Sun3PM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Wed3PM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Wed3PM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Sun4AM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Sun4AM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Sun4PM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Sun4PM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Wed4PM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Wed4PM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Sun5AM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Sun5AM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Sun5PM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Sun5PM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
ElseIf Not Intersect(Target, Wed5PM) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Wed5PM, Target.Value) > 1 Then _

MsgBox Target.Value & " is already used.", vbInformation, _

“Duplicate Entry!”
Else

Exit Sub
End If
End Sub

This works but very hard to manage. Someone please enlighten me to a nice simple loop. I will be copying this sheet, making a new copy each month so the code must remain “current sheet” and work on any sheet the user is working on.

Many Thanks!!!

#excel #excel-vba