API tools faq
paste
Advertisement
AlanElston

Appraisal - Drop Down 11 11.xls

AlanElston
Nov 13th, 2020
1,820
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 16.94 KB | None | 0 0
raw download clone embed print report
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3. Rem 1 worksheets info
  4. Dim WsApp As Worksheet, WsComs As Worksheet, WsActual As Worksheet, WsAdv As Worksheet
  5.  Set WsAdv = ThisWorkbook.Worksheets("Advise"): Set WsApp = ThisWorkbook.Worksheets("Appraisal"): Set WsComs = ThisWorkbook.Worksheets("Comments"): Set WsActual = ThisWorkbook.Worksheets("Actual Appraisal Form")
  6.  
  7. Dim RwTrgt As Long: Let RwTrgt = Target.Row
  8.  
  9. ' Rem 2 Rem 3 Rem 4 Rem5 Topics, determined by row selection in columns A and C -------------------------------------------
  10.    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
  11.    Rem 2 Topic: SOCIAL COMPETENCIES
  12.      '2a_ --------------------------------------   Communicating effectively
  13.        If Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A1").Value Then
  14.         ' create list 4 Advice
  15.         Me.Range("G" & RwTrgt & "").Validation.Delete
  16.          Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A2:A11"
  17.         ' Now go through the 3 Choose Options
  18.            If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A2").Value Then                 ' Does Not Meet Expectation
  19.            '2a(i) create list 3  Does Not Meet Expectation
  20.             Me.Range("D" & RwTrgt & "").Validation.Delete
  21.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A3:A8"
  22.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B2").Value Then             ' Meets Expectation
  23.            '2a(ii) create list 3  Meets Expectation
  24.             Me.Range("D" & RwTrgt & "").Validation.Delete
  25.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B3:B8"
  26.            
  27.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C2").Value Then             ' Exceeds Expectation
  28.            '2a(iii) create list 3  Exceeds Expectation
  29.             Me.Range("D" & RwTrgt & "").Validation.Delete
  30.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C3:C8"
  31.  
  32.             End If ' this is end of cases of  {Does Not Meet Expectation,  Meets Expectation,  Exceeds Expectation}
  33.  
  34.  
  35.  
  36.     '2b_ --------------------------------------  Resolving Conflict
  37.        ElseIf Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A14").Value Then
  38.         ' create list 4 Advice
  39.         Me.Range("G" & RwTrgt & "").Validation.Delete
  40.          Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A15:A24"
  41.         ' Now go through the 3 Choose Options
  42.            If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A12").Value Then                 ' Does Not Meet Expectation
  43.            '2a(i) create list 3  Does Not Meet Expectation
  44.             Me.Range("D" & RwTrgt & "").Validation.Delete
  45.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A13:A18"
  46.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B12").Value Then             ' Meets Expectation
  47.            '2a(ii) create list 3  Meets Expectation
  48.             Me.Range("D" & RwTrgt & "").Validation.Delete
  49.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B13:B18"
  50.            
  51.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C12").Value Then             ' Exceeds Expectation
  52.            '2a(iii) create list 3 Exceeds Expectation
  53.             Me.Range("D" & RwTrgt & "").Validation.Delete
  54.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C13:C18"
  55.  
  56.             End If ' this is end of cases of  {Does Not Meet Expectation,  Meets Expectation,  Exceeds Expectation}
  57.  
  58.        
  59.        
  60.     '2c_ --------------------------------------  Sharing Information
  61.        
  62.         ElseIf Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A27").Value Then             ' Sharing Information
  63.        ' create list 4 Advice
  64.         Me.Range("G" & RwTrgt & "").Validation.Delete
  65.          Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A28:A32"
  66.         ' Now go through the 3 Choose Options
  67.            If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A22").Value Then                 ' Does Not Meet Expectation
  68.            '2a(i) create list 3 for case  Does Not Meet Expectation
  69.             Me.Range("D" & RwTrgt & "").Validation.Delete
  70.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A23:A28"
  71.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B22").Value Then             ' Meets Expectation
  72.            '2a(ii) create list 3 for case  Meets Expectation
  73.             Me.Range("D" & RwTrgt & "").Validation.Delete
  74.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B23:B28"
  75.            
  76.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C22").Value Then             ' Exceeds Expectation
  77.            '2a(iii) create list 3 for case  Exceeds Expectation
  78.             Me.Range("D" & RwTrgt & "").Validation.Delete
  79.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C23:C28"
  80.  
  81.             End If ' this is end of cases of  {Does Not Meet Expectation,  Meets Expectation,  Exceeds Expectation}
  82.  
  83.        
  84.        
  85.     '2d_ --------------------------------------  Supporting Co-workers
  86.        
  87.         ElseIf Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A35").Value Then             ' Supporting Co-workers
  88.        ' create list 4 Advice
  89.         Me.Range("G" & RwTrgt & "").Validation.Delete
  90.          Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A36:A48"
  91.         ' Now go through the 3 Choose Options
  92.            If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A32").Value Then                 ' Does Not Meet Expectation
  93.            '2a(i) create list 3 for case  Does Not Meet Expectation
  94.             Me.Range("D" & RwTrgt & "").Validation.Delete
  95.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A33:A38"
  96.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B32").Value Then             ' Meets Expectation
  97.            '2a(ii) create list 3 for case  Meets Expectation
  98.             Me.Range("D" & RwTrgt & "").Validation.Delete
  99.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B33:B38"
  100.            
  101.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C32").Value Then             ' Exceeds Expectation
  102.            '2a(iii) create list 3 for case  Exceeds Expectation
  103.             Me.Range("D" & RwTrgt & "").Validation.Delete
  104.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C33:C38"
  105.              
  106.             End If ' this is end of cases of  {Does Not Meet Expectation,  Meets Expectation,  Exceeds Expectation}
  107.        
  108.         Else
  109.         End If
  110.     '  this is end of cases of Topic  social competencies
  111.    
  112.     ElseIf Not Application.Intersect(Target, Me.Range("A29:A30,C29:C30")) Is Nothing Then
  113.     Rem 3 Topic: PERSONAL COMPETENCIES
  114.      '3a_ -------------------------------------- Adapting to Change
  115.        ' create list 4 Advice
  116.         Me.Range("G" & RwTrgt & "").Validation.Delete
  117.          Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A52:A67"
  118.         ' Now go through the 3 Choose Options
  119.            If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A32").Value Then                 ' Does Not Meet Expectation
  120.            '3a(i) create list 3 for case  Does Not Meet Expectation
  121.             Me.Range("D" & RwTrgt & "").Validation.Delete
  122.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A43:A48"
  123.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B32").Value Then             ' Meets Expectation
  124.            '3a(ii) create list 3 for case  Meets Expectation
  125.             Me.Range("D" & RwTrgt & "").Validation.Delete
  126.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B43:B48"
  127.            
  128.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C32").Value Then             ' Exceeds Expectation
  129.            '3a(iii) create list 3 for case  Exceeds Expectation
  130.             Me.Range("D" & RwTrgt & "").Validation.Delete
  131.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C43:C48"
  132.              
  133.             End If ' this is end of cases of  {Does Not Meet Expectation,  Meets Expectation,  Exceeds Expectation}
  134.    '3b_ --------------------------------------  Demonstrating Tenacity and Perseverance
  135.        ' create list 4 Advice
  136.        ' Now go through the 3 Choose Options
  137.            '3b(i) create list 3  Does Not Meet Expectation
  138.            '3b(ii) create list 3  Meets Expectation
  139.            '3b(iii) create list 3 Exceeds Expectation
  140.    '3c_ --------------------------------------  Following Policies and Procedures
  141.        ' create list 4 Advice
  142.        ' Now go through the 3 Choose Options
  143.            '3c(i) create list 3 for case  Does Not Meet Expectation
  144.            '3c(ii) create list 3 for case  Meets Expectation
  145.            '3c(iii) create list 3 for case  Exceeds Expectation
  146.    '3d_ --------------------------------------  Learning Quickly
  147.        ' create list 4 Advice
  148.        ' Now go through the 3 Choose Options
  149.            '3d(i) create list 3 for case  Does Not Meet Expectation
  150.            '3d(ii) create list 3 for case  Meets Expectation
  151.            '3d(iii) create list 3 for case  Exceeds Expectation
  152.    '3e_ --------------------------------------  Pursuing Self-Development
  153.  
  154.         ' create list 4 Advice
  155.        ' Now go through the 3 Choose Options
  156.            '3e(i) create list 3 for case  Does Not Meet Expectation
  157.            '3e(ii) create list 3 for case  Meets Expectation
  158.            '3e(iii) create list 3 for case  Exceeds Expectation
  159.    '3f_ --------------------------------------  Supporting Organizational Goals
  160.        ' create list 4 Advice
  161.        ' Now go through the 3 Choose Options
  162.            '3f(i) create list 3 for case  Does Not Meet Expectation
  163.            '3f(ii) create list 3 for case  Meets Expectation
  164.            '3f(iii) create list 3 for case  Exceeds Expectation
  165.    '  this is end  of Topic  PERSONAL COMPETENCIES
  166.  
  167.     ElseIf Not Application.Intersect(Target, Me.Range("A32:A33,C32:C33")) Is Nothing Then
  168.     Rem 4 Topic: METHODOLOGICAL COMPETENCIES
  169.      '4a_ -------------------------------------- Evaluating and Implementing Ideas
  170.        ' create list 4 Advice
  171.         Me.Range("G" & RwTrgt & "").Validation.Delete
  172.          Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A131:A139"
  173.         ' Now go through the 3 Choose Options
  174.            If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A12").Value Then                 ' Does Not Meet Expectation
  175.            '4a(i) create list 3  Does Not Meet Expectation
  176.             Me.Range("D" & RwTrgt & "").Validation.Delete
  177.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A103:A108"
  178.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B12").Value Then             ' Meets Expectation
  179.            '4a(ii) create list 3  Meets Expectation
  180.             Me.Range("D" & RwTrgt & "").Validation.Delete
  181.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B103:B108"
  182.            
  183.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C12").Value Then             ' Exceeds Expectation
  184.            '4a(iii) create list 3 Exceeds Expectation
  185.             Me.Range("D" & RwTrgt & "").Validation.Delete
  186.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C103:C108"
  187.  
  188.             End If ' this is end of cases of  {Does Not Meet Expectation,  Meets Expectation,  Exceeds Expectation}
  189.    '4b_ --------------------------------------  Managing Time
  190.        ' create list 4 Advice
  191.        ' Now go through the 3 Choose Options
  192.            '4b(i) create list 3  Does Not Meet Expectation
  193.            '4b(ii) create list 3  Meets Expectation
  194.            '4b(iii) create list 3 Exceeds Expectation
  195.    '4c_ --------------------------------------  Prioritizing and Organizing Work
  196.        ' create list 4 Advice
  197.        ' Now go through the 3 Choose Options
  198.            '4c(i) create list 3 for case  Does Not Meet Expectation
  199.            '4c(ii) create list 3 for case  Meets Expectation
  200.            '4c(iii) create list 3 for case  Exceeds Expectation
  201.    '4d_ --------------------------------------  Solving Complex Problems
  202.        ' create list 4 Advice
  203.        ' Now go through the 3 Choose Options
  204.            '4d(i) create list 3 for case  Does Not Meet Expectation
  205.            '4d(ii) create list 3 for case  Meets Expectation
  206.            '4d(iii) create list 3 for case  Exceeds Expectation
  207.    '  this is end  of Topic  METHODOLOGICAL COMPETENCIES
  208.    
  209.     ElseIf Not Application.Intersect(Target, Me.Range("A35:A36,C35:C36")) Is Nothing Then
  210.     Rem 5 Topic: LEADERSHIP COMPETENCIES
  211.      '5a_ -------------------------------------- Accepting Responsibility  Acting Strategically ???????
  212.        ' create list 4 Advice
  213.         Me.Range("G" & RwTrgt & "").Validation.Delete
  214.          Me.Range("G" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A190:A198"
  215.         ' Now go through the 3 Choose Options
  216.            If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A12").Value Then                 ' Does Not Meet Expectation
  217.            '5a(i) create list 3  Does Not Meet Expectation
  218.             Me.Range("D" & RwTrgt & "").Validation.Delete
  219.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!A143:A148"
  220.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("B12").Value Then             ' Meets Expectation
  221.            '5a(ii) create list 3  Meets Expectation
  222.             Me.Range("D" & RwTrgt & "").Validation.Delete
  223.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!B143:B148"
  224.            
  225.             ElseIf Me.Range("C" & RwTrgt & "").Value = WsComs.Range("C12").Value Then             ' Exceeds Expectation
  226.            '5a(iii) create list 3 Exceeds Expectation
  227.             Me.Range("D" & RwTrgt & "").Validation.Delete
  228.              Me.Range("D" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Comments!C143:C148"
  229.  
  230.             End If ' this is end of cases of  {Does Not Meet Expectation,  Meets Expectation,  Exceeds Expectation}
  231.    '5b_ --------------------------------------  Delegating Responsibility
  232.        ' create list 4 Advice
  233.        ' Now go through the 3 Choose Options
  234.            '5b(i) create list 3  Does Not Meet Expectation
  235.            '5b(ii) create list 3  Meets Expectation
  236.            '5b(iii) create list 3 Exceeds Expectation
  237.    '5c_ --------------------------------------  Developing Talent
  238.        ' create list 4 Advice
  239.        ' Now go through the 3 Choose Options
  240.            '5c(i) create list 3 for case  Does Not Meet Expectation
  241.            '5c(ii) create list 3 for case  Meets Expectation
  242.            '5c(iii) create list 3 for case  Exceeds Expectation
  243.    '5d_ --------------------------------------  Driving for Results
  244.  
  245.         ' create list 4 Advice
  246.        ' Now go through the 3 Choose Options
  247.            '5d(i) create list 3 for case  Does Not Meet Expectation
  248.            '5d(ii) create list 3 for case  Meets Expectation
  249.            '5d(iii) create list 3 for case  Exceeds Expectation
  250.    '5e_ --------------------------------------  Inspiring and Motivating Others
  251.        ' create list 4 Advice
  252.        ' Now go through the 3 Choose Options
  253.            '5e(i) create list 3 for case  Does Not Meet Expectation
  254.            '5e(ii) create list 3 for case  Meets Expectation
  255.            '5e(iii) create list 3 for case  Exceeds Expectation
  256.    '5f_ --------------------------------------  Managing Performance
  257.        ' create list 4 Advice
  258.        ' Now go through the 3 Choose Options
  259.            '5f(i) create list 3 for case  Does Not Meet Expectation
  260.            '5f(ii) create list 3 for case  Meets Expectation
  261.            '5f(iii) create list 3 for case  Exceeds Expectation
  262.    '  this is end  of Topic  LEADERSHIP COMPETENCIES
  263.    
  264.     Else '
  265.     ' 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
  266.    End If  '  This is the end of all Topics
  267. '  Énd of all Topics ------------------------------------------------------------------------------------------------------
  268. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!