VBA to automatically loop through validation list with any change

[mgerving]

I have a validation list that when a specific date is selected, it runs a "PasteData" macro.
How do I insert code to automatically loop through all the dates in the list, any time there is a change in the Sheet?
The PasteData sub runs perfectly, just trying to make this more automatic.

Sub Worksheet_Change(ByVal Target As Range)
Set Target = Range("B3")
If Target.Value = "Nov 20" Then
Call PasteData
End If
Set Target = Range("B3")
If Target.Value = "June 21" Then
Call PasteData
End If
Set Target = Range("B3")
If Target.Value = "Nov 21" Then
Call PasteData
End If
Set Target = Range("B3")
If Target.Value = "June 22" Then
Call PasteData
End If
Set Target = Range("B3")
If Target.Value = "Nov 22" Then
Call PasteData
End If
Set Target = Range("B3")
If Target.Value = "June 23" Then
Call PasteData
End If
Set Target = Range("B3")
If Target.Value = "Nov 23" Then
Call PasteData
End If
End Sub

 

[Fluff]

What is the validation rule in B3?

 

[mgerving]

"=Period" Named Range

 

[mgerving]

On this same worksheet, "Metropolitan", I have a "Blend" command button that takes you to the worksheet, "Blend Rates" that holds all the pastes values.
Private Sub Blend_Click()
MsgBox ("Cycle Through all rate periods before proceeding")
Sheets("Blend Rates").Select
Sheets("Blend Rates").Range("B6").Select
Blend.AutoSize = False
Blend.AutoSize = True
Blend.Height = 25.5
Blend.Left = 213
Blend.Width = 105
End Sub

Is it easier to make this command button do the Loop?
Screen shot:

REI LU26 Labor Rate Worksheet - test.5.xlsm
	A	B																																				AL	AM
1
2		Metropolitan
3		Nov 20
4																																							0%
5	Classification	Base Rate																																				Total Rate	Profit on Total Rate
6	GF	$ 58.00																																				$ 92.50	$ 92.50
7	GF 10% Shift	$ 63.80																																				$ 99.54	$ 99.54
8	GF 15% Shift	$ 66.70																																				$103.06	$103.06
9	GF Overtime	$ 87.00																																				$127.71	$127.71
10	GF Overtime + 10% Shift	$ 95.70																																				$138.27	$138.27
11	GF Overtime + 15% Shift	$ 100.05																																				$143.56	$143.56
12	GF Double Time	$ 116.00																																				$162.92	$162.92
Metropolitan

Cell Formulas
Range	Formula
B6	B6	=B$62+10
B7,B10	B7	=B6*1.1
B8,B11	B8	=B6*1.15
B9	B9	=B6*1.5
B12	B12	=B6*2
AL6:AL12	AL6	=SUM(U6:AK6)
AM6:AM12	AM6	=SUM(AL6*$AM$4)+AL6

Cells with Data Validation
Cell	Allow	Criteria
B2	List	=Local
B3	List	=Period

 

[mgerving]

Sorry Xl2bb isn't capturing all the items:

 

[Fluff]

Is the code in the Metropolitan sheet module?

 

[mgerving]

yes

 

[Fluff]

You need to remove the word "period" from the code so it's just

Range(Replace(Cl.Validation.Formula1, "=", ""))

in both places.

 

[mgerving]

got the same results..."No validation"

 

[Fluff]

Can you post the code you are using?

 

[mgerving]

I put this all into a much smaller workbook...Book100
Sheet 1

Book100.xlsm
	A	B	C	D	E
1
2				Month	October
3				Week	2
4
5		Base	Com 1	Com 2	Total
6	Joe	600	55	75	730
7	Tom	700	55	30	785
8	Sally	800	55	200	1055
9	Betty	900	55	25	980
10
Sheet1

Cell Formulas
Range	Formula
B6	B6	=INDEX(Months!B3:E6,MATCH($E$2,Month,0),MATCH($E$3,Person,0))
B7	B7	=INDEX(Months!B10:E13,MATCH($E$2,Month,0),MATCH($E$3,Person,0))
B8	B8	=INDEX(Months!B17:E20,MATCH($E$2,Month,0),MATCH($E$3,Person,0))
B9	B9	=INDEX(Months!B24:E27,MATCH($E$2,Month,0),MATCH($E$3,Person,0))
E6:E9	E6	=SUM(B6:D6)

Named Ranges
Name	Refers To	Cells
Month	=Months!$A$3:$A$6	B6:B9
Person	=Months!$B$2:$E$2	B6:B9

Cells with Data Validation
Cell	Allow	Criteria
E2	List	=Month
E3:E4	List	=Person

Months Worksheet

Book100.xlsm
	A	B	C	D	E
1		Joe
2		1	2	3	4
3	Sept	100	500	900	400
4	October	200	600	100	500
5	November	300	700	200	600
6	December	400	800	300	700
7
8		Tom
9		1	2	3	4
10	Sept	200	600	100	500
11	October	300	700	200	600
12	November	400	800	300	700
13	December	500	900	400	800
14
15		Sally
16		1	2	3	4
17	Sept	300	700	200	600
18	October	400	800	300	700
19	November	500	900	400	800
20	December	600	100	500	900
21
22		Betty
23		1	2	3	4
24	Sept	400	800	300	700
25	October	500	900	400	800
26	November	600	100	500	900
27	December	700	200	600	100
Months

Blend Worksheet

Book100.xlsm
	A	B	C	D	E	F
1
2		Week
3		1	2	3	4
4	Joe					0
5	Tom					0
6	Sally					0
7	Betty					0
Blend

Cell Formulas
Range	Formula
F4:F7	F4	=IFERROR(AVERAGE(B4:E4),0)

Sheet1 VBA

Private Sub Blend_Click()
    MsgBox ("Cycle Through all rate periods before proceeding")
    Sheets("Blend").Select
    Sheets("Blend").Range("B2").Select
End Sub

Sub Worksheet_Change(ByVal Target As Range)
   Dim Cl As Range, ListRng As Range
   Dim Ary As Variant
   Dim i As Long

   Set Cl = Range("E3")
   On Error Resume Next
   Set ListRng = Range(Replace(Cl.Validation.Formula1, "=", ""))
   On Error GoTo 0
  
   If ListRng Is Nothing Then
      MsgBox "No validation"
      Exit Sub
   End If
   ReDim Ary(1 To ListRng.Rows.Count)

   For i = 1 To ListRng.Rows.Count
       Ary(i) = Range(Replace(Cl.Validation.Formula1, "=", "")).Cells(i, 1)
   Next i
   For i = 1 To UBound(Ary)
      Cl.Value = Ary(i)
      Application.Calculate
      Call PasteData
   Next i
   'Set Target = Range("E3")
    'If Target.Value = "1" Then
        'Call PasteData
    'End If
    'Set Target = Range("E3")
    'If Target.Value = "2" Then
        'Call PasteData
    'End If
    'Set Target = Range("E3")
    'If Target.Value = "3" Then
        'Call PasteData
    'End If
    'Set Target = Range("E3")
    'If Target.Value = "4" Then
        'Call PasteData
    'End If
End Sub
Sub PasteData()
    If Worksheets("Sheet1").Range("E3").Value = 1 Then
        Worksheets("Sheet1").Range("E6:E9").Copy
        Worksheets("Blend").Range("B4:B7").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
    If Worksheets("Sheet1").Range("E3").Value = 2 Then
        Worksheets("Sheet1").Range("E6:E9").Copy
        Worksheets("Blend").Range("C4:C7").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
    If Worksheets("Sheet1").Range("E3").Value = 3 Then
        Worksheets("Sheet1").Range("E6:E9").Copy
        Worksheets("Blend").Range("D4:D7").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
    If Worksheets("Sheet1").Range("E3").Value = 4 Then
        Worksheets("Sheet1").Range("E6:E9").Copy
        Worksheets("Blend").Range("E4:E7").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
       
End Sub