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

[DocAElstein]

Macro for this post
https://excelfox.com/forum/showthrea...ll=1#post15085

https://imgur.com/rteyeHM https://i.imgur.com/rteyeHM.jpg http://i.imgur.com/rteyeHM.jpg


https://imgur.com/ex9FlRI https://i.imgur.com/ex9FlRI http://i.imgur.com/ex9FlRI


https://imgur.com/ZjEw5xy https://i.imgur.com/ZjEw5xy http://i.imgur.com/ZjEw5xy

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Rem 0 worksheets info
Dim WsAdv As Worksheet, WsComs As Worksheet
 Set WsAdv = ThisWorkbook.Worksheets("Advise"): Set WsComs = ThisWorkbook.Worksheets("Comments")

Rem 1 Restrict  most of the macro workings to only be done when specific ranges are chosen. In our case those ranges are column A and C
    If Application.Intersect(Target, Me.Range("A2:A8,C2:C8")) Is Nothing Then
    ' do nothing because there was no intersection of the changed range, Target, and the cells of lists 1 and 2
    Else
    Rem 2
    Dim RwTrgt As Long: Let RwTrgt = Target.Row
     '2a_ --------------------------------------   Communicating effectively
        If Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A1").Value Then                 ' Communicating Effectively
        ' create list 4 for case Communicating Effectively
         Me.Range("E" & RwTrgt & "").Validation.Delete
         Me.Range("E" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A2:A11"
        ' Now go through the 3 Choose Options for case Communicating Effectively
            If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A2").Value Then                 ' Does Not Meet Expectation
            '2a(i) create list 3 for case Communicating Effectively and 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 for case Communicating Effectively and 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 for case Communicating Effectively and Exceeds Expectation


            End If ' this is end of cases of  {Does Not Meet Expectation,  Meets Expectation,  Exceeds Expectation} for the case of Communicating effectively for Social Competencies
    '_ --------------------------------------


    '2b_ --------------------------------------  Resolving Conflict
        ElseIf Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A14").Value Then             ' Resolving Conflict
        ' create list 4 for case Resolving Conflict
        
    '_ --------------------------------------
        
        
    '2c_ --------------------------------------  Sharing Information
        
        ElseIf Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A27").Value Then             ' Sharing Information
        ' create list 4 for case Sharing Information
        
    '_ --------------------------------------
        
        
    '2d_ --------------------------------------  Supporting Co-workers
        
        ElseIf Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A35").Value Then             ' Supporting Co-workers
        ' create list 4 for case Supporting Co-workers
        
    '_ --------------------------------------
        
        End If   '  this is end of cases of  social competencies
    
    
    End If  '   This is end of checking for selected range in columns A an C ( drop down lists 1 and 2 )

End Sub

---

---

Summary of coding: ( Private Sub Worksheet_Change(ByVal Target As Range) -----
https://excelfox.com/forum/showthrea...ll=1#post15087 )
Rem 1
We usually restrict most of the macro workings to only be done when specific ranges are chosen. In our case those ranges are column A and C from row 2 to row 8

Rem 2
In this section we go through the combinations of SOCIAL COMPETENCIES and Please Choose, and then create the appropriate drop down lists 3 and 4

‘2a) Communicating effectively
_... ‘2a(i) Does Not Meet Expectation
_... ‘2a(ii) Meets Expectation
_... ‘2a(iii) Exceeds Expectation

‘2b) Resolving Conflict
_... ‘2b(i) Does Not Meet Expectation
_... ‘2b(ii) Meets Expectation
_... ‘2b(iii) Exceeds Expectation

‘2c) Sharing Information
_... ‘2c(i) Does Not Meet Expectation
_... ‘2c(ii) Meets Expectation
_... ‘2c(iii) Exceeds Expectation

‘2d) Supporting Co-workers
_... ‘2d(i) Does Not Meet Expectation
_... ‘2d(ii) Meets Expectation
_... ‘2d(iii) Exceeds Expectation

---

[DocAElstein]

In support of this Thread post:
https://excelfox.com/forum/showthrea...ll=1#post15090


First attempt by siyab.

Private Sub Worksheet_Change(ByVal Target As Range)
Rem 0 worksheets info
Dim WsAdv As Worksheet, WsComs As Worksheet
 Set WsAdv = ThisWorkbook.Worksheets("Advise"): Set WsComs = ThisWorkbook.Worksheets("Comments")

Rem 1 Restrict  most of the macro workings to only be done when specific ranges are chosen. In our case those ranges are column A and C
    If Application.Intersect(Target, Me.Range("A2:A8,C2:C8")) Is Nothing Then
    ' do nothing because there was no intersection of the changed range, Target, and the cells of lists 1 and 2
    Else
    Rem 2
    Dim RwTrgt As Long: Let RwTrgt = Target.Row
     '2a_ --------------------------------------   Communicating effectively
        If Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A1").Value Then                 ' Communicating Effectively
        ' create list 4 for case Communicating Effectively
         Me.Range("E" & RwTrgt & "").Validation.Delete
         Me.Range("E" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A2:A11"
        ' Now go through the 3 Choose Options for case Communicating Effectively
            If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A2").Value Then                 ' Does Not Meet Expectation
            '2a(i) create list 3 for case Communicating Effectively and 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 for case Communicating Effectively and 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 for case Communicating Effectively and 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} for the case of Communicating effectively for Social Competencies
    '_ --------------------------------------


    '2b_ --------------------------------------  Resolving Conflict
        ElseIf Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A14").Value Then             ' Resolving Conflict
        ' create list 4 for case Resolving Conflict
         Me.Range("E" & RwTrgt & "").Validation.Delete
         Me.Range("E" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A15:A24"
        ' Now go through the 3 Choose Options for case Resolving Conflict
            If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A12").Value Then                 ' Does Not Meet Expectation
            '2b(i) create list 3 for case Communicating Effectively and 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
            '2b(ii) create list 3 for case Communicating Effectively and 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
            '2b(iii) create list 3 for case Communicating Effectively and 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} for the case of Resolving Conflicts for Social Competencies
    '_ --------------------------------------
        
        
    '2c_ --------------------------------------  Sharing Information
        
        ElseIf Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A27").Value Then             ' Sharing Information
        ' create list 4 for case Sharing Information
         Me.Range("E" & RwTrgt & "").Validation.Delete
         Me.Range("E" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A28:A32"
        ' Now go through the 3 Choose Options for case Sharing Information
            If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A22").Value Then                 ' Does Not Meet Expectation
            '2c(i) create list 3 for case Communicating Effectively and 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
            '2c(ii) create list 3 for case Communicating Effectively and 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
            '2c(iii) create list 3 for case Communicating Effectively and 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} for the case of Sharing Information for Social Competencies
    '_ --------------------------------------
        
        
    '2d_ --------------------------------------  Supporting Co-workers
        
        ElseIf Me.Range("A" & RwTrgt & "").Value = WsAdv.Range("A35").Value Then             ' Supporting Co-workers
        ' create list 4 for case Supporting Co-workers
         Me.Range("E" & RwTrgt & "").Validation.Delete
         Me.Range("E" & RwTrgt & "").Validation.Add Type:=xlValidateList, Formula1:="=Advise!A36:A48"
        ' Now go through the 3 Choose Options for case Supporting Co-workers
            If Me.Range("C" & RwTrgt & "").Value = WsComs.Range("A32").Value Then                 ' Does Not Meet Expectation
            '2d(i) create list 3 for case Communicating Effectively and 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
            '2d(ii) create list 3 for case Communicating Effectively and 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
            '2d(iii) create list 3 for case Communicating Effectively and 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} for the case of Supporting Co-workers for Social Competencies
    '_ --------------------------------------
        End If   '  this is end of cases of  social competencies
    End If  '   This is end of checking for selected range in columns A an C ( drop down lists 1 and 2 )
End Sub

[DocAElstein]

Some extra info for this Thread
https://excelfox.com/forum/showthrea...rop-Down-Lists




This is just some extra information, just out of passing interest.
You may be interested in adding another macro in the Appraisals worksheet object code module, a Private Sub Worksheet_SelectionChange(ByVal Target As Range) , :
https://imgur.com/BssuDnk , https://i.imgur.com/BssuDnk


This macro will make the drop down lists appear in columns D an E when the cell is selected:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Rem 1 Restrict  most of the macro workings to only be done when specific ranges are chosen. In our case those ranges are column A and C
    If Application.Intersect(Target, Me.Range("D2:E8")) Is Nothing Then
    ' do nothing because there was no intersection of the changed range, Target, and the cells of lists 3 and 4
    Else  '  https://www.mrexcel.com/board/threads/auto-show-drop-down-list-when-selecting-the-cell.1144911/#post-5550521
    Dim lDVType As XlDVType
        If Target.Cells.CountLarge = 1 Then
         On Error Resume Next
         lDVType = Target.Validation.Type
         On Error GoTo 0
            If lDVType = xlValidateList Then SendKeys "%{down}"
        End If
    End If
End Sub

This macro will make the drop down lists appear in columns C and D an E when the cell is selected:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Rem 1 Restrict  most of the macro workings to only be done when specific ranges are chosen. In our case those ranges are column A and C
    If Application.Intersect(Target, Me.Range("C2:E8")) Is Nothing Then
    ' do nothing because there was no intersection of the changed range, Target, and the cells of lists 2 and 3 and 4
    Else  '  https://www.mrexcel.com/board/threads/auto-show-drop-down-list-when-selecting-the-cell.1144911/#post-5550521
    Dim lDVType As XlDVType
        If Target.Cells.CountLarge = 1 Then
         On Error Resume Next
         lDVType = Target.Validation.Type
         On Error GoTo 0
            If lDVType = xlValidateList Then SendKeys "%{down}"
        End If
    End If
End Sub

This macro will make the drop down lists for any cells appear when selecting the cell associated with the list.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Rem 1 Restrict  most of the macro workings to only be done when specific ranges are chosen. In our case those ranges are column A and C
    If Application.Intersect(Target, Me.Range("C2:E8")) Is Nothing Then
    ' do nothing because there was no intersection of the changed range, Target, and the cells of lists 2 and 3 and 4
    Else  '  https://www.mrexcel.com/board/threads/auto-show-drop-down-list-when-selecting-the-cell.1144911/#post-5550521
    Dim lDVType As XlDVType
        If Target.Cells.CountLarge = 1 Then
         On Error Resume Next
         lDVType = Target.Validation.Type
         On Error GoTo 0
            If lDVType = xlValidateList Then SendKeys "%{down}"
        End If
    End If
    
' .....Merged cells often cause difficulties with vba code. .....   https://www.mrexcel.com/board/threads/auto-show-drop-down-list-when-selecting-the-cell.1144911/#post-5550550
    If Application.Intersect(Target, Me.Range("A2:B8")) Is Nothing Then
    ' do nothing because there was no intersection of the changed range, Target, and the cells of list 1
    Else
        If Target.Cells.CountLarge = 2 And Target.Rows.CountLarge = 1 Then
         SendKeys "%{down}"
        End If
    End If

Ref
https://www.mrexcel.com/board/thread...-cell.1144911/
https://excelfox.com/forum/showthrea...cting-the-Cell

---

Share ‘Appraisal - Automatic Drop Down.xls’ : https://app.box.com/s/wj11tpgc9fsuoekp023cd7ndkkqyvtm1

[DocAElstein]

In support of this Post
https://excelfox.com/forum/showthrea...5110#post15110

Sub MakeNormalDropDowns2x4() '  https://excelfox.com/forum/showthread.php/2676-Dependent-Drop-Down-Lists?p=15110&viewfull=1#post15110
Rem 1 worksheets info
Dim WsApp As Worksheet, WsComs As Worksheet, WsActual As Worksheet
 Set WsApp = ThisWorkbook.Worksheets("Appraisal"): Set WsComs = ThisWorkbook.Worksheets("Comments"): Set WsActual = ThisWorkbook.Worksheets("Actual Appraisal Form")

Rem  FirstTwoDropDowns

Rem 2 SOCIAL COMPETENCIES
'2a) Topic SOCIAL COMPETENCIES            List 1 in column A
 WsActual.Range("A26:A27").Validation.Delete
 WsActual.Range("A26:A27").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A1").Value & "," & WsComs.Range("A11").Value & "," & WsComs.Range("A21").Value & "," & WsComs.Range("A31").Value & ""

'2b) Please Choose                        List 2 in column C
 WsActual.Range("C26:C27").Validation.Delete
 WsActual.Range("C26:C27").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A2").Value & "," & WsComs.Range("B2").Value & "," & WsComs.Range("C2").Value & ""

Rem 3 PERSONAL COMPETENCIES
'3a) Topic PERSONAL COMPETENCIES          List 1 in column A
 WsActual.Range("A29:A30").Validation.Delete
 WsActual.Range("A29:A30").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A41").Value & "," & WsComs.Range("A51").Value & "," & WsComs.Range("A61").Value & "," & WsComs.Range("A71").Value & "," & WsComs.Range("A81").Value & "," & WsComs.Range("A91").Value & ""

'3b) Please Choose                        List 2 in column C
 WsActual.Range("C29:C30").Validation.Delete
 WsActual.Range("C29:C30").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A2").Value & "," & WsComs.Range("B2").Value & "," & WsComs.Range("C2").Value & ""

Rem 4 METHODOLOGICAL COMPETENCIES
'4a) Topic METHODOLOGICAL COMPETENCIES    List 1 in column A
 WsActual.Range("A32:A33").Validation.Delete
 WsActual.Range("A32:A33").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A111").Value & "," & WsComs.Range("A121").Value & "," & WsComs.Range("A131").Value & ""

'4b) Please Choose                        List 2 in column C
 WsActual.Range("C32:C33").Validation.Delete
 WsActual.Range("C32:C33").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A2").Value & "," & WsComs.Range("B2").Value & "," & WsComs.Range("C2").Value & ""

Rem 5 LEADERSHIP COMPETENCIES
'5a) Topic LEADERSHIP COMPETENCIES        List 1 in column A
 WsActual.Range("A35:A36").Validation.Delete
 WsActual.Range("A35:A36").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A141").Value & "," & WsComs.Range("A151").Value & "," & WsComs.Range("A161").Value & "," & WsComs.Range("A171").Value & "," & WsComs.Range("A181").Value & "," & WsComs.Range("A191").Value & ""

'5b) Please Choose                        List 2 in column C
 WsActual.Range("C35:C36").Validation.Delete
 WsActual.Range("C35:C36").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A2").Value & "," & WsComs.Range("B2").Value & "," & WsComs.Range("C2").Value & ""


End Sub

Sub MakeNormalDropDowns1x4andLoop4times() '  https://excelfox.com/forum/showthread.php/2561-Appendix-Thread-(-Codes-for-other-Threads-etc-)-Event-Coding-Drpdown-Data-validation?p=15111&viewfull=1#post15111  https://excelfox.com/forum/showthread.php/2676-Dependent-Drop-Down-Lists?p=15110&viewfull=1#post15110
Rem 1 worksheets info
Dim WsApp As Worksheet, WsComs As Worksheet, WsActual As Worksheet
 Set WsApp = ThisWorkbook.Worksheets("Appraisal"): Set WsComs = ThisWorkbook.Worksheets("Comments"): Set WsActual = ThisWorkbook.Worksheets("Actual Appraisal Form")

Rem  FirstTwoDropDowns

Rem 2 SOCIAL COMPETENCIES
'2a) Topic SOCIAL COMPETENCIES            List 1 in column A
 WsActual.Range("A26:A27").Validation.Delete
 WsActual.Range("A26:A27").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A1").Value & "," & WsComs.Range("A11").Value & "," & WsComs.Range("A21").Value & "," & WsComs.Range("A31").Value & ""

Rem 3 PERSONAL COMPETENCIES
'3a) Topic PERSONAL COMPETENCIES          List 1 in column A
 WsActual.Range("A29:A30").Validation.Delete
 WsActual.Range("A29:A30").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A41").Value & "," & WsComs.Range("A51").Value & "," & WsComs.Range("A61").Value & "," & WsComs.Range("A71").Value & "," & WsComs.Range("A81").Value & "," & WsComs.Range("A91").Value & ""

Rem 4 METHODOLOGICAL COMPETENCIES
'4a) Topic METHODOLOGICAL COMPETENCIES    List 1 in column A
 WsActual.Range("A32:A33").Validation.Delete
 WsActual.Range("A32:A33").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A111").Value & "," & WsComs.Range("A121").Value & "," & WsComs.Range("A131").Value & ""

Rem 5 LEADERSHIP COMPETENCIES
'5a) Topic LEADERSHIP COMPETENCIES        List 1 in column A
 WsActual.Range("A35:A36").Validation.Delete
 WsActual.Range("A35:A36").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A141").Value & "," & WsComs.Range("A151").Value & "," & WsComs.Range("A161").Value & "," & WsComs.Range("A171").Value & "," & WsComs.Range("A181").Value & "," & WsComs.Range("A191").Value & ""


Rem    Please Choose - all 4 ranges in a loop
Dim Ofst As Long
    For Ofst = 0 To 9 Step 3
     WsActual.Range("C26:C27").Offset(RowOffset:=Ofst, ColumnOffset:=0).Validation.Delete
     WsActual.Range("C26:C27").Offset(RowOffset:=Ofst, ColumnOffset:=0).Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A2").Value & "," & WsComs.Range("B2").Value & "," & WsComs.Range("C2").Value & ""
    Next Ofst

End Sub

---

Share 'Appraisal - Drop Down 11 11.xls' : https://app.box.com/s/wj11tpgc9fsuoekp023cd7ndkkqyvtm1

[DocAElstein]

In support of this Thread
https://excelfox.com/forum/showthrea...5110#post15110

[DocAElstein]

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 )

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
    
    ElseIf Not Application.Intersect(Target, Me.Range("A29:A30,C29:C30")) Is Nothing Then
    Rem 3 Topic: PERSONAL COMPETENCIES
    
    ElseIf Not Application.Intersect(Target, Me.Range("A32:A33,C32:C33")) Is Nothing Then
    Rem 4 Topic: METHODOLOGICAL COMPETENCIES
    
    ElseIf Not Application.Intersect(Target, Me.Range("A35:A36,C35:C36")) Is Nothing Then
    Rem 5 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

[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 )

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
        ' create list 4 Advice
        ' Now go through the 3 Choose Options
            '2a(i) create list 3  Does Not Meet Expectation
            '2a(ii) create list 3  Meets Expectation
            '2a(iii) create list 3  Exceeds Expectation
    '2b_ --------------------------------------  Resolving Conflict
        ' create list 4 Advice
        ' Now go through the 3 Choose Options
            '2b(i) create list 3  Does Not Meet Expectation
            '2b(ii) create list 3  Meets Expectation
            '2b(iii) create list 3 Exceeds Expectation
    '2c_ --------------------------------------  Sharing Information
        ' create list 4 Advice
        ' Now go through the 3 Choose Options
            '2c(i) create list 3 for case  Does Not Meet Expectation
            '2c(ii) create list 3 for case  Meets Expectation
            '2c(iii) create list 3 for case  Exceeds Expectation
    '2d_ --------------------------------------  Supporting Co-workers
        ' create list 4 Advice
        ' Now go through the 3 Choose Options
            '2d(i) create list 3 for case  Does Not Meet Expectation
            '2d(ii) create list 3 for case  Meets Expectation
            '2d(iii) create list 3 for case  Exceeds Expectation
    '  this is end  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
        ' Now go through the 3 Choose Options
            '3a(i) create list 3  Does Not Meet Expectation
            '3a(ii) create list 3  Meets Expectation
            '3a(iii) create list 3  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
        ' Now go through the 3 Choose Options
            '4a(i) create list 3  Does Not Meet Expectation
            '4a(ii) create list 3  Meets Expectation
            '4a(iii) create list 3  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
        ' Now go through the 3 Choose Options
            '5a(i) create list 3  Does Not Meet Expectation
            '5a(ii) create list 3  Meets Expectation
            '5a(iii) create list 3  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

At lot of the tedious typing can be simplifies by copy ( Ctrl+c ) and pasting ( Ctrl+v ) and sometimes further the modification can be done easier using tools such as Search and Replace on highlighted text
SearchReplaceInVBEditor.JPG
https://imgur.com/4Ou7Q6q https://i.imgur.com/4Ou7Q6q.jpg


Note: Make sure you select Highlighted text

SearchReplaceInVBEditorOnHighlightedText.JPG
https://imgur.com/Wvw7Ol1.jpg https://i.imgur.com/Wvw7Ol1.jpg

[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 )





This was almost a direct copy from the previous macro for Rem 2
I only had to change all the
Me.Range("E" & RwTrgt & "")
to
Me.Range("G" & RwTrgt & "")

This change was necessary because the Advice range has moved from column E to column G

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
    

[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

[DocAElstein]

In support of answer for this post
https://excelfox.com/forum/showthrea...5113#post15113
( second complicated part: lists 3 and 4 based on choice from Lists 1 and 2
https://excelfox.com/forum/showthrea...ll=1#post15119)





Here is the next macro for you:
Share ‘Code Appraisal - Drop Down 11 11 xls .txt’ : https://app.box.com/s/jd6mgsnd5mkwuidi2idrpf72a3d91xvq
Share ‘Appraisal - Drop Down 11 11.xls’ : https://app.box.com/s/vuggryhlalxu3qjeztkt2jby3wv9jzoj
https://pastebin.com/Avgsv1h6