In support of this Thread
https://excelfox.com/forum/showthrea...5110#post15110
In support of this Thread
https://excelfox.com/forum/showthrea...5110#post15110
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 )
Code: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
Last edited by DocAElstein; 11-14-2020 at 01:01 PM.
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
Code: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
Last edited by DocAElstein; 11-14-2020 at 01:01 PM.
In support of this Post
https://excelfox.com/forum/showthrea...5110#post15110
Code: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
Code: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
Last edited by DocAElstein; 11-12-2020 at 03:58 PM.
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 )
Code: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
Last edited by DocAElstein; 11-14-2020 at 01:00 PM.
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
Code: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
Last edited by DocAElstein; 11-14-2020 at 01:02 PM.
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
Last edited by DocAElstein; 11-14-2020 at 12:59 PM.
Posting Permissions
Reply With Quote
Bookmarks