Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Activate()
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] oFrt [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] oRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
ReDim ray(1 To Rng.Count * 5)
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
oFrt = Split(Dn, "-")
[COLOR="Navy"]For[/COLOR] Rw = 0 To UBound(oFrt)
[COLOR="Navy"]If[/COLOR] Not .Exists(oFrt(Rw)) [COLOR="Navy"]Then[/COLOR] .Add oFrt(Rw), ""
[COLOR="Navy"]Next[/COLOR] Rw
[COLOR="Navy"]Next[/COLOR] Dn
Range("F1").Resize(.Count) = Application.Transpose(.Keys)
[COLOR="Navy"]Set[/COLOR] oRng = Range("F1").Resize(.Count)
[COLOR="Navy"]End[/COLOR] With
Range("B1").Select
[COLOR="Navy"]With[/COLOR] Selection.Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=" & oRng.Address & ""
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]If[/COLOR] Target.Address(0, 0) = "B1" [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] InStr(Dn, Target) = 0 [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] nRng = Dn
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Hidden = True
[a1].Select
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Private [COLOR="Navy"]Sub[/COLOR] Worksheet_SelectionChange(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]If[/COLOR] Target.Address(0, 0) = "B1" [COLOR="Navy"]Then[/COLOR]
Columns("A:A").EntireRow.Hidden = False
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]