Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Rem 1 worksheets info Dim WsApp As Worksheet, WsComs As Worksheet, WsActual As Worksheet, WsAdv As Worksheet Set WsAdv = ThisWorkbook.Worksheets("Advise"): Set WsApp = ThisWorkbook.Worksheets("Appraisal"): Set WsComs = ThisWorkbook.Worksheets("Comments"): Set WsActual = ThisWorkbook.Worksheets("Actual Appraisal Form") Dim RwTrgt As Long: Let RwTrgt = Target.Row ' Rem 2 Rem 3 Rem 4 Rem5 Topics, determined by row selection in columns A and C ------------------------------------------- If Not Application.Intersect(Target, Me.Range("A26:A27,C26:C27")) Is Nothing Then ' Not nothing means we changed something in A26:A27 or C26:C27 Rem 2 Topic: SOCIAL COMPETENCIES '2a_ -------------------------------------- Communicating effectively If Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A1").Value Then ' create list 4 Advice Me.Range("G" & RwTrgt & "").Validation.Delete Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A2:A11" ' Now go through the 3 Choose Options If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A2").Value Then ' Does Not Meet Expectation '2a(i) create list 3 Does Not Meet Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A3:A8" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B2").Value Then ' Meets Expectation '2a(ii) create list 3 Meets Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B3:B8" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C2").Value Then ' Exceeds Expectation '2a(iii) create list 3 Exceeds Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C3:C8" End If ' this is end of cases of {Does Not Meet Expectation, Meets Expectation, Exceeds Expectation} '2b_ -------------------------------------- Resolving Conflict ElseIf Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A14").Value Then ' create list 4 Advice Me.Range("G" & RwTrgt & "").Validation.Delete Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A15:A24" ' Now go through the 3 Choose Options If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A12").Value Then ' Does Not Meet Expectation '2a(i) create list 3 Does Not Meet Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A13:A18" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B12").Value Then ' Meets Expectation '2a(ii) create list 3 Meets Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B13:B18" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C12").Value Then ' Exceeds Expectation '2a(iii) create list 3 Exceeds Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C13:C18" End If ' this is end of cases of {Does Not Meet Expectation, Meets Expectation, Exceeds Expectation} '2c_ -------------------------------------- Sharing Information ElseIf Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A27").Value Then ' Sharing Information ' create list 4 Advice Me.Range("G" & RwTrgt & "").Validation.Delete Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A28:A32" ' Now go through the 3 Choose Options If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A22").Value Then ' Does Not Meet Expectation '2a(i) create list 3 for case Does Not Meet Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A23:A28" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B22").Value Then ' Meets Expectation '2a(ii) create list 3 for case Meets Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B23:B28" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C22").Value Then ' Exceeds Expectation '2a(iii) create list 3 for case Exceeds Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C23:C28" End If ' this is end of cases of {Does Not Meet Expectation, Meets Expectation, Exceeds Expectation} '2d_ -------------------------------------- Supporting Co-workers ElseIf Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A35").Value Then ' Supporting Co-workers ' create list 4 Advice Me.Range("G" & RwTrgt & "").Validation.Delete Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A36:A48" ' Now go through the 3 Choose Options If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A32").Value Then ' Does Not Meet Expectation '2a(i) create list 3 for case Does Not Meet Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A33:A38" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B32").Value Then ' Meets Expectation '2a(ii) create list 3 for case Meets Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B33:B38" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C32").Value Then ' Exceeds Expectation '2a(iii) create list 3 for case Exceeds Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C33:C38" End If ' this is end of cases of {Does Not Meet Expectation, Meets Expectation, Exceeds Expectation} Else End If ' this is end of cases of Topic social competencies ElseIf Not Application.Intersect(Target, Me.Range("A29:A30,C29:C30")) Is Nothing Then Rem 3 Topic: PERSONAL COMPETENCIES '3a_ -------------------------------------- Adapting to Change ' create list 4 Advice Me.Range("G" & RwTrgt & "").Validation.Delete Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A52:A67" ' Now go through the 3 Choose Options If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A32").Value Then ' Does Not Meet Expectation '3a(i) create list 3 for case Does Not Meet Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A43:A48" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B32").Value Then ' Meets Expectation '3a(ii) create list 3 for case Meets Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B43:B48" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C32").Value Then ' Exceeds Expectation '3a(iii) create list 3 for case Exceeds Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C43:C48" End If ' this is end of cases of {Does Not Meet Expectation, Meets Expectation, Exceeds Expectation} '3b_ -------------------------------------- Demonstrating Tenacity and Perseverance ' create list 4 Advice ' Now go through the 3 Choose Options '3b(i) create list 3 Does Not Meet Expectation '3b(ii) create list 3 Meets Expectation '3b(iii) create list 3 Exceeds Expectation '3c_ -------------------------------------- Following Policies and Procedures ' create list 4 Advice ' Now go through the 3 Choose Options '3c(i) create list 3 for case Does Not Meet Expectation '3c(ii) create list 3 for case Meets Expectation '3c(iii) create list 3 for case Exceeds Expectation '3d_ -------------------------------------- Learning Quickly ' create list 4 Advice ' Now go through the 3 Choose Options '3d(i) create list 3 for case Does Not Meet Expectation '3d(ii) create list 3 for case Meets Expectation '3d(iii) create list 3 for case Exceeds Expectation '3e_ -------------------------------------- Pursuing Self-Development ' create list 4 Advice ' Now go through the 3 Choose Options '3e(i) create list 3 for case Does Not Meet Expectation '3e(ii) create list 3 for case Meets Expectation '3e(iii) create list 3 for case Exceeds Expectation '3f_ -------------------------------------- Supporting Organizational Goals ' create list 4 Advice ' Now go through the 3 Choose Options '3f(i) create list 3 for case Does Not Meet Expectation '3f(ii) create list 3 for case Meets Expectation '3f(iii) create list 3 for case Exceeds Expectation ' this is end of Topic PERSONAL COMPETENCIES ElseIf Not Application.Intersect(Target, Me.Range("A32:A33,C32:C33")) Is Nothing Then Rem 4 Topic: METHODOLOGICAL COMPETENCIES '4a_ -------------------------------------- Evaluating and Implementing Ideas ' create list 4 Advice Me.Range("G" & RwTrgt & "").Validation.Delete Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A131:A139" ' Now go through the 3 Choose Options If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A12").Value Then ' Does Not Meet Expectation '4a(i) create list 3 Does Not Meet Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A103:A108" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B12").Value Then ' Meets Expectation '4a(ii) create list 3 Meets Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B103:B108" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C12").Value Then ' Exceeds Expectation '4a(iii) create list 3 Exceeds Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C103:C108" End If ' this is end of cases of {Does Not Meet Expectation, Meets Expectation, Exceeds Expectation} '4b_ -------------------------------------- Managing Time ' create list 4 Advice ' Now go through the 3 Choose Options '4b(i) create list 3 Does Not Meet Expectation '4b(ii) create list 3 Meets Expectation '4b(iii) create list 3 Exceeds Expectation '4c_ -------------------------------------- Prioritizing and Organizing Work ' create list 4 Advice ' Now go through the 3 Choose Options '4c(i) create list 3 for case Does Not Meet Expectation '4c(ii) create list 3 for case Meets Expectation '4c(iii) create list 3 for case Exceeds Expectation '4d_ -------------------------------------- Solving Complex Problems ' create list 4 Advice ' Now go through the 3 Choose Options '4d(i) create list 3 for case Does Not Meet Expectation '4d(ii) create list 3 for case Meets Expectation '4d(iii) create list 3 for case Exceeds Expectation ' this is end of Topic METHODOLOGICAL COMPETENCIES ElseIf Not Application.Intersect(Target, Me.Range("A35:A36,C35:C36")) Is Nothing Then Rem 5 Topic: LEADERSHIP COMPETENCIES '5a_ -------------------------------------- Accepting Responsibility Acting Strategically ??????? ' create list 4 Advice Me.Range("G" & RwTrgt & "").Validation.Delete Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A190:A198" ' Now go through the 3 Choose Options If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A12").Value Then ' Does Not Meet Expectation '5a(i) create list 3 Does Not Meet Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A143:A148" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B12").Value Then ' Meets Expectation '5a(ii) create list 3 Meets Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B143:B148" ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C12").Value Then ' Exceeds Expectation '5a(iii) create list 3 Exceeds Expectation Me.Range("D" & RwTrgt & "").Validation.Delete Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C143:C148" End If ' this is end of cases of {Does Not Meet Expectation, Meets Expectation, Exceeds Expectation} '5b_ -------------------------------------- Delegating Responsibility ' create list 4 Advice ' Now go through the 3 Choose Options '5b(i) create list 3 Does Not Meet Expectation '5b(ii) create list 3 Meets Expectation '5b(iii) create list 3 Exceeds Expectation '5c_ -------------------------------------- Developing Talent ' create list 4 Advice ' Now go through the 3 Choose Options '5c(i) create list 3 for case Does Not Meet Expectation '5c(ii) create list 3 for case Meets Expectation '5c(iii) create list 3 for case Exceeds Expectation '5d_ -------------------------------------- Driving for Results ' create list 4 Advice ' Now go through the 3 Choose Options '5d(i) create list 3 for case Does Not Meet Expectation '5d(ii) create list 3 for case Meets Expectation '5d(iii) create list 3 for case Exceeds Expectation '5e_ -------------------------------------- Inspiring and Motivating Others ' create list 4 Advice ' Now go through the 3 Choose Options '5e(i) create list 3 for case Does Not Meet Expectation '5e(ii) create list 3 for case Meets Expectation '5e(iii) create list 3 for case Exceeds Expectation '5f_ -------------------------------------- Managing Performance ' create list 4 Advice ' Now go through the 3 Choose Options '5f(i) create list 3 for case Does Not Meet Expectation '5f(ii) create list 3 for case Meets Expectation '5f(iii) create list 3 for case Exceeds Expectation ' this is end of Topic LEADERSHIP COMPETENCIES Else ' ' we come here if had changed something anywhere else other than ranges A26:A27,C26:C27, A29:A30,C29:C30, A32:A33,C32:C33, A35:A36,C35:C36 End If ' This is the end of all Topics ' Énd of all Topics ------------------------------------------------------------------------------------------------------ End Sub