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, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, Dic [COLOR="Navy"]As[/COLOR] Object, Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] WS [COLOR="Navy"]As[/COLOR] Worksheet
[COLOR="Navy"]Dim[/COLOR] shp [COLOR="Navy"]As[/COLOR] Shape
[COLOR="Navy"]Dim[/COLOR] addr [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] lastRow [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] tRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] shpName [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] shpPath [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] filepath [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]If[/COLOR] Target.Column = 3 [COLOR="Navy"]Then[/COLOR]
Application.EnableEvents = False
Cells(Target.Row, 17).Value = Date + Time
Application.EnableEvents = True
[COLOR="Navy"]Set[/COLOR] WS = ActiveSheet
shpPath = filepath
[COLOR="Navy"]If[/COLOR] Right(shpPath, 1) <> Application.PathSeparator [COLOR="Navy"]Then[/COLOR] shpPath = shpPath & Application.PathSeparator
[COLOR="Navy"]If[/COLOR] Dir(shpPath) = "" [COLOR="Navy"]Then[/COLOR] MsgBox shpPath & " is invalid!", vbCritical, "INVALID PATH": [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
lastRow = WorksheetFunction.Max(8, WS.Cells(Rows.Count, "A").End(xlUp).Row + 2)
[COLOR="Navy"]If[/COLOR] Not Intersect(Target, Range("A8:A" & lastRow)) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] tRng = Cells(Target.Row, "T")
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]If[/COLOR] Len(Trim(Target.Value)) = 0 [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
Me.Shapes("PictureAt" & tRng.Address).Delete
Err.Clear
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] GoTo 0
[COLOR="Navy"]Else[/COLOR]
Err.Clear
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] GoTo 0
shpName = Target.Value
[COLOR="Navy"]If[/COLOR] Len(Trim(shpName)) > 0 [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]With[/COLOR] Application
.ScreenUpdating = False
.EnableEvents = False
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] tRng
.RowHeight = 56
.ClearContents
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
Me.Shapes("PictureAt" & .Address).Delete
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] GoTo 0
[COLOR="Navy"]End[/COLOR] With
If Dir(shpPath & Target & ".jpg") <> "" Then '[COLOR="Green"][B]* verify that the file exists[/B][/COLOR]
[COLOR="Navy"]With[/COLOR] tRng
[COLOR="Navy"]Set[/COLOR] shp = Me.Shapes.AddPicture(shpPath & shpName & ".jpg", msoFalse, msoCTrue, .Left, .Top, .Width, .Height)
shp.Name = "PictureAt" & .Address
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Else[/COLOR]
tRng.Value = "NO IMAGE" & Chr(10) & "FOUND"
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]With[/COLOR] Application
.ScreenUpdating = True
.EnableEvents = True
[COLOR="Navy"]If[/COLOR] (Intersect(Target, Range("A1:G2")) [COLOR="Navy"]Is[/COLOR] Nothing) [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
[COLOR="Navy"]If[/COLOR] Range("A7:Z500000").CurrentRegion.Rows.Count > 1 [COLOR="Navy"]Then[/COLOR]
Range("A7:Z500000").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:G2")
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]ElseIf[/COLOR] Target.Column = 1 [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1:A100")
[COLOR="Navy"]If[/COLOR] Intersect(Target, Rng) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Ray = Array("AK", "OR")
[COLOR="Navy"]For[/COLOR] n = 0 To 1
[COLOR="Navy"]For[/COLOR] Num = 1 To 100
Dic(Ray(n) & Num) = Empty
[COLOR="Navy"]Next[/COLOR] Num
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = False
[COLOR="Navy"]If[/COLOR] Target.Count = 1 [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not Dn.Value = vbNullString [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
.Add (Dn.Value), ""
[COLOR="Navy"]Else[/COLOR]
Dn.Value = ""
MsgBox "Duplicate Entry"
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]If[/COLOR] Not Target.Value = vbNullString [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]If[/COLOR] Not Dic.exists(Target.Value) [COLOR="Navy"]Then[/COLOR]
Target = ""
MsgBox "Invalid Entry"
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = True
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]