Appendix Thread. ( Codes for other Threads, etc.) Event Coding Drpdown Data validation

[DocAElstein]

continued from last post - Some extra notes in development of answer for this post
https://excelfox.com/forum/showthrea...ll=1#post15119
( second complicated part: lists 3 and 4 based on choice from Lists 1 and 2 )





One small step further,
PERSONAL COMPETENCIES Adapting to Change
PERSONAL COMPETENCIES Adapting to Change.JPG
https://i.imgur.com/1Eu9oa4.jpg https://imgur.com/1Eu9oa4

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