Printable View
' https://excelfox.com/forum/showthrea...ll=1#post14885Code:Sub test()
SendKeys "%s{Enter}"
MsgBox ("please just click OK")
End Sub
' https://excelfox.com/forum/showthrea...ll=1#post14877
' https://excelfox.com/forum/showthrea...cting-the-Cell
' http://www.eileenslounge.com/viewtop...277023#p277023
Insupport of this Thread post:
https://excelfox.com/forum/showthrea...5085#post15085
Code:Sub MakeDropDownList1and2() ' https://excelfox.com/forum/showthread.php/2676-Dependent-Drop-Down-Lists?p=15085&viewfull=1#post15085
Rem 1 worksheets info
Dim WsApp As Worksheet, WsComs As Worksheet
Set WsApp = ThisWorkbook.Worksheets("Appraisal"): Set WsComs = ThisWorkbook.Worksheets("Comments")
Rem 2 FirstTwoDropDowns2
' 2a) List 1 in column A
WsApp.Range("A2:A8").Validation.Delete
WsApp.Range("A2:A8").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A1").Value & "," & WsComs.Range("A11").Value & "," & WsComs.Range("A21").Value & "," & WsComs.Range("A31").Value & ""
'2b) list 2 in column C
WsComs.Range("C2:C8").Validation.Delete
WsComs.Range("C2:C8").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A2").Value & "," & WsComs.Range("B2").Value & "," & WsComs.Range("C2").Value & ""
End Sub
Notes in support of this thread:
https://excelfox.com/forum/showthrea...rop-Down-Lists
Following approximately these steps:
https://support.microsoft.com/en-us/...9-c5402dce407b
Worksheets info from OP:
Requirements:
1. Under "Social Competencies", the drop down list should contain all the headers from the sheet "Comments" (Color Code - Peach).
2. Under "Please Choose", the drop down list should contain "Does Not Meet Expectation", "Meets Expectation", "Exceeds Expectation" (Color Code - Grey).
3. So, If a person selects "Communicating Effectively" under Social Competencies column, and then selects "Meets Expectation" in the next column, then the drop down list on Column D "Please Choose" should display the list from B3:B8 from the sheet named "Comments".
Another example would be if a person selects "Resolving Conflict" under Social Competencies column, and then selects "Does Not Meet Expectation" in the next column, then the drop down list on Column D "Please Choose" should display the list from A13:A18 from the sheet named "Comments".
4. So, If a person selects "Sharing Information" under Social Competencies column, then the drop down list on Column E "Give Advise" should display the list from A28:A32 from the sheet named "Give Advise"
_____ Workbook: Appraisal - Drop Down.xls ( Using Excel 2007 32 bit )
Worksheet: Appraisal
Row\Col A B C D E 1 SOCIAL COMPETENCIES Please Choose Comments Give Advise 2 3 4 5 6 7 8
Continued in next post…._
Continued in next post…._
_..... continued from last post
Worksheets info from OP:
Requirements:
1. Under "Social Competencies", the drop down list should contain all the headers from the sheet "Comments" (Color Code - Peach).
2. Under "Please Choose", the drop down list should contain "Does Not Meet Expectation", "Meets Expectation", "Exceeds Expectation" (Color Code - Grey).
3. So, If a person selects "Communicating Effectively" under Social Competencies column, and then selects "Meets Expectation" in the next column, then the drop down list on Column D "Please Choose" should display the list from B3:B8 from the sheet named "Comments".
Another example would be if a person selects "Resolving Conflict" under Social Competencies column, and then selects "Does Not Meet Expectation" in the next column, then the drop down list on Column D "Please Choose" should display the list from A13:A18 from the sheet named "Comments".
4. So, If a person selects "Sharing Information" under Social Competencies column, then the drop down list on Column E "Give Advise" should display the list from A28:A32 from the sheet named "Give Advise"
_____ Workbook: Appraisal - Drop Down.xls ( Using Excel 2007 32 bit )
Worksheet: Comments
Row\Col A B C 1 Communicating Effectively 2 Does Not Meet Expectation Meets Expectation Exceeds Expectation 3 Assumes understanding. Actively listens. Encourages others to share information. 4 Difficult to contact. Communicates regularly with team members. Excellent listener. 5 Does not adapt language to listener. Communicates with team members. Gives people full attention. 6 Does not give others full attention. Conveys enthusiasm. Promotes candid and open atmosphere. 7 Ideas and comments are hard to follow. Gives people full attention. Shares information with team. 8 Uses overly complex language. Shares information with team. Shares useful information. 9 10 11 Resolving Conflict 12 Does Not Meet Expectation Meets Expectation Exceeds Expectation 13 Becomes emotional dealing with conflict. Avoids emotional involvement. Diffuses conflicts before they start. 14 Gives up easily, misses opportunities. Avoids unnecessary conflict. Finds permanent fixes to tough conflicts. 15 Is caught off guard by conflicts. Handles difficult people. Handles difficult people easily. 16 Needs to focus on problems, not people. Helps others end disputes. Listens to all, hears all sides. 17 Shies away from conflict, lets it escalate. Tries to find roots of conflict. Top peacekeeper, solution-finder. 18 Too confrontational, focused on win-lose. Uses good listening, communication skills. 19 20 21 Sharing Information 22 Does Not Meet Expectation Meets Expectation Exceeds Expectation 23 Does not communicate experience or knowledge to others. Effectively communicates information and keeps teammates on the same page. Carefully listens to what others have to say and adds insightful comments; asks important questions. 24 Does not listen to others. Keep key players informed. Conveys extremely complex information in a simple fashion. 25 Does not share relevant information to the team. Knows the appropriate amount of knowledge to share with others. Does not act aloof or arrogant, is humble and happy to help. 26 Does not speak up. Prior to presenting and idea or sharing information, run it by someone first. Helps foster and cultivate an environment that is open to exchange of information. 27 Shares too little information. Shares useful information with teammates. Informs the team with specific information to achieve and surpass goals. 28 Shares useless information. Willingly shares leadership skills and knowledge with others. Provides expert information and knowledge with teammates. 29 30 31 Supporting Co-workers 32 Does Not Meet Expectation Meets Expectation Exceeds Expectation 33 Could be more collaborative. Appreciates others. Able to resolve conflict. 34 Could be more open-minded. Collaborates with others. Excellent listening skills. 35 Does not respond to others' needs. Helps resolve team conflicts. Flexible and open-minded. 36 does not support new members Proactively share information and suggestions to help new team members get up to speed as fast as possible. Includes others. 37 Excessively critical of others. Welcomes new team members. Promotes team spirit. 38 Rarely accommodates others. Willing to help. Provides support.
Continued in next post…._
_..........Continued from last post
_____ Workbook: Appraisal - Drop Down.xls ( Using Excel 2007 32 bit )
Worksheet: Advise
Row\Col A 1 Communicating Effectively 2 Effective communication can be challenging. Often, ineffective communication results from misunderstanding. Try not to get discouraged if at first others do not understand what you are saying. Make your best efforts to restate and clarify. 3 Remember that effective communication requires listening skills. Think about how you would like others to listen when you are trying to explain something. Be that listener for others. 4 When communicating with others, try to gauge your audience effectively. Gather adequate information in order to communicate as effectively as possible. 5 Spend time organizing your thoughts before you write a document or give a presentation. Draw pictures or a timeline if that helps. Determine where you want your audience to be at the conclusion. Try to identify the optimal steps to get your audience where you want them to be. 6 Rehearse and practice before giving presentations. Individuals who practice prior to presenting appear to be more effective communicators than those individuals who do not. 7 Be sure to give your full attention to others. If you schedule a time to meet with someone be sure to actively be present. 8 Take on projects where you can be the lead. This will allow you to help you hone your communication skills. 9 Take on projects where a final document or presentation will be given to your teammates or superiors. 10 Books you may find useful: Ekman, P. (2007). Emotions Revealed, Second Edition: Recognizing Faces and Feelings to Improve Communication and Emotional Life.; Alder, R. B., Elmhorst, J. M. (2008). Communicating at Work: Principles and Practices for Business and the Professions.; Alessandra, T. (1993). Communicating at Work. 11 Books you may find useful: Lewis, G. (2000). The Mentoring Manager: Strategies for Fostering Talent and Spreading Knowledge.; Ingwersen, P., Jarvelin, K. (2005). The Turn: Integration of Information Seeking and Retrieval in Context. 12 13 14 Resolving Conflict 15 One difficulty in dealing with conflict is doing so without becoming emotionally invested. Highly emotional people may struggle with seeing the situation objectively. When people feel personally invested, it will become difficult to reach a resolution. 16 It is common for people who struggle with negotiation to also struggle with conflict resolution. This is not surprising because both involve working with others to reach a common ground. Negotiation is often a critical skill in resolving conflict. It may be beneficial to try improving your negotiation skills in order to more effectively manage conflict. 17 Wait a few seconds (or days) before answering. When a person says something to you that gets under your skin, give yourself the time you need to respond objectively and not react impulsively. That may take a couple seconds or it may require that you table the issue until you've had time or are in a better frame of mind to deal with it constructively. 18 Put yourself in another person's position. Why is this person acting confrontational? What do they really want? What pressure is on them? Try to look a level deeper to find a point from which you can start a more productive conversation. 19 Keep communication open. Get in the habit of asking all participants, especially the least vocal attendees, for their input. A simple """"""""What's your take on this, Bill?"""""""" or """"""""What do you think about that idea, Judy?"""""""" can often bring out valuable opinions or underlying issues. In order to do this, you'll also have to limit the time each person has to speak. 20 Give your input objectively. Whether or not you feel intensely involved in the conflict, state your opinions on the issues objectively and independently. Avoid the appearance of taking sides. If your opinion is clearly on one side or the other, try to state it in terms different than those used by the disagreeing parties. 21 Fix the process. Many conflicts and aggravation can be caused by systems and processes, or lack thereof. Work with the people involved to locate the sticking points and help them figure out how to change the process if it is causing problems. 22 Try taking on a position as a conflict mediator. This can help you to see how conflicts tend to escalate, and how they tend to be resolved in the end. The more you observe conflicts and help others to resolve them, the easier it will become to use the same techniques in your own interactions. 23 Work with people. Conflict resolution is an interpersonal skill that must be developed by interacting with people. Experience with people will help improve your understanding of interpersonal relationships. This will help you to better resolve conflicts as well as to avoid them in the first place. 24 Books you may find useful: Isenhart, Myra and Spangle, Michael. Collaborative Approaches to Resolving Conflict. Sage Publications, 2000; Yankelovich, Daniel. The Magic of Dialogue: Transforming Conflict into Cooperation. Simon & Schuster, Inc., 1999; Mayer, Bernard. Beyond Neutrality: Confronting the Crisis to Conflict Resolution. John Wiley & Sons, Inc., 2004. 25 26 27 Sharing Information 28 Examine your experiences and determine if there is pertinent information you can share with the group. If there is, find an appropriate time to speak up. On every team you are a part of you provide not only a unique set of skills, but also unique experiences that may hold to the answer to a problem. 29 Figure out the best way for you to actively engage in discussion. Help create an environment that is best for you and others to share their ideas. Identify teams and people with whom you are most comfortable to work. Learn to work with those individuals you are not as comfortable working with. 30 Speak your opinion without stepping on other people's toes. Try to be constructively critical of ideas and build off of them. 31 Share enough information to accomplish the goal, but don't overload people. If you can tell people are not retaining information then be more specific and less detailed. 32 Resist the temptation to sit back. Force yourself to speak up at each meeting. Keep your focus on the main goal. 33 34 35 Supporting Co-workers 36 Inspiring and motivating others effectively requires that you be motivated as well. People will not respond well to being told to do something their boss is not willing to do. If you are not enthusiastic and don't challenge yourself, people will recognize this and their motivation will suffer. 37 Focusing too heavily on your own tasks without considering others can cause you to seem uncommitted to the members of your team. It is important that your team feel valued or you will struggle with motivating them to reach their goals. This requires taking a regular and active interest in the work they are doing, including helping them address and overcome challenges and obstacles. 38 Appeal to your audience. Think about what is important to the people you'll be talking to about the organization's vision. Are they people who will want to get down to the details? Or do they only have a minute to understand what you're talking about? Think about it and modify your pitch to what will be most effective. 39 Make a conscious effort to check your plans against organizational goals and the overall vision. Keep checking the plans as they evolve to make sure they continue to support long-term organizational interests. 40 Expand organizational contacts. Use informal contacts in other groups and departments to broaden your knowledge of organizational operations. Develop new contacts who can give you new insight into the company's goals and help you better understand how your work fits into the broader organizational strategy. 41 Be positive, enthusiastic. Remember that your attitude and mood can affect others no matter what you are saying. Smile, be energetic when you speak, look people in the eye. The more enthusiastic you are about your ideas, the more committed others are likely to be in supporting you. 42 Look at needs and wants. The key to managing and improving performance lies in understanding each employees' needs and wants and showing how their tasks and assignments relate to their personal career goals and desires. Simply taking time to sincerely talk with people about their job satisfaction, engagement, and career ambitions can help increase their sense of motivation. 43 Share responsibility for all outcomes. If the outcome is good, share praise and rewards. If the outcome is bad, let individuals know what the consequences are and how they could improve their part in the future. 44 Not everyone values the same rewards. Learn what motivates your people. Use a variety of methods to reward people including public recognition, financial incentives, work assignments that match their goals, or other ways to provide them with things they value. Don't promise more than you can deliver, but be creative in what you promise. 45 Recognize achievements immediately. Don't delay rewarding hard work. Make sure that your appreciation is given while accomplishments are still fresh in someone's mind. 46 Make your criticism constructive and actionable. When someone has made a mistake, don't talk to them before you've come up with at least one specific thing they can do to improve. Get in the habit of giving all employees specific incident-oriented criticism. Show the employee the steps to take to be successful, and show your interest in their success. 47 Encourage staff to step up and set high standards for themselves. Make it clear that setting ambitious goals and reaching them is something that will be appreciated and rewarded in your organization. 48 Books you may find useful: Staley, M.F. (1998). Igniting the Leader Within: Inspiring, Motivating, & Influencing Others. Saddle Brook: Fire Engineering Books & Videos; Nair, K. (1993). Leadership as Service. Audiobook: Stanford Alumni Association; Bruce, A., & Pepitone, J.S. (1999). Motivating Employees. New York: McGraw-Hill Companies, Inc.
Notes in support of this thread:
https://excelfox.com/forum/showthrea...rop-Down-Lists
Following approximately these steps:
https://support.microsoft.com/en-us/...9-c5402dce407b
Worksheets info from OP:
Requirements:
1. Under "Social Competencies", the drop down list should contain all the headers from the sheet "Comments" (Color Code - Peach).
2. Under "Please Choose", the drop down list should contain "Does Not Meet Expectation", "Meets Expectation", "Exceeds Expectation" (Color Code - Grey).
3. So, If a person selects "Communicating Effectively" under Social Competencies column, and then selects "Meets Expectation" in the next column, then the drop down list on Column D?? "Please Choose" should display the list from B3:B8 from the sheet named "Comments".
Another example would be if a person selects "Resolving Conflict" under Social Competencies column, and then selects "Does Not Meet Expectation" in the next column, then the drop down list on Column D "Please Choose" should display the list from A13:A18 from the sheet named "Comments".
4. So, If a person selects "Sharing Information" under Social Competencies column, then the drop down list on Column E "Give Advise" should display the list from A28:A32 from the sheet named "Give Advise"
( ?? typo – probably should be C)
See screenshots in last three posts for worksheets info
https://excelfox.com/forum/showthrea...ll=1#post15074
https://excelfox.com/forum/showthrea...ll=1#post15075
https://excelfox.com/forum/showthrea...ll=1#post15076
I initially made some temporary ranges, -
_____ Workbook: Appraisal - Drop Down.xls ( Using Excel 2007 32 bit )
Worksheet: Comments
Row\Col D E F G 1 2 Communicating Effectively 3 Resolving Conflict 4 Sharing Information 5 Supporting Co-workers 6 7 Does Not Meet Expectation Meets Expectation Exceeds Expectation 8
I then ran a macro recording whilst following approximately the instructions here: https://support.microsoft.com/en-us/...9-c5402dce407b
This is approximately what the macro recorder produced. ( I added Later some 'note comments )Code:Sub Macro2() ' https://excelfox.com/forum/showthread.php/2561-Appendix-Thread-(-Codes-for-other-Threads-etc-)-Event-Coding-Drpdown-Data-validation?p=15077&viewfull=1#post15077
'In a new worksheet, type the entries you want to appear in your drop-down list. - I made some temporary ranges in second worksheet
Range("E2").Select
ActiveCell.FormulaR1C1 = "Communicating Effectively"
Range("E4").Select
ActiveCell.FormulaR1C1 = "Sharing Information"
Range("E5").Select
ActiveCell.FormulaR1C1 = "Supporting Co-workers"
Range("E6").Select
Range("A12:C12").Select
Selection.Copy
Range("E7").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Select the range in the worksheet where you want the drop down list
Range("A2:A8").Select
'Go to the Data tab on the Ribbon, then Data Validation. 'On the Settings tab, in the Allow box, click List. 'Click in the Source box, then select your list range. Click OK
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Comments!E2:E5"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Range("C2:C8").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Comments!E7:G7"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
End Sub
I see you're a famous writer ;)
All my codings and postings are beautiful
I am a writer, and Artist also.
Notes in support of this thread:
https://excelfox.com/forum/showthrea...rop-Down-Lists
Here are a few attempts at a macro , based on the macro produced from the macro recorder in the last post.
Code:Sub MakeFirstTwoDropDowns1() '
With ThisWorkbook.Worksheets("Appraisal").Range("A2:A8").Validation
.Delete
'.Add Type:=xlValidateList, Formula1:="=Comments!E2:E5"
.Add Type:=xlValidateList, Formula1:="Communicating Effectively,Resolving Conflict,Sharing Information,Supporting Co - workers"
End With
With ThisWorkbook.Worksheets("Appraisal").Range("C2:C8").Validation
.Delete
'.Add Type:=xlValidateList, Formula1:="=Comments!E2:E5"
.Add Type:=xlValidateList, Formula1:="Does Not Meet Expectation,Meets Expectation,Exceeds Expectation"
End With
End Sub
Sub MakeFirstTwoDropDowns2()
Rem 1 worksheets info
Dim WsApp As Worksheet, WsComs As Worksheet
Set WsApp = ThisWorkbook.Worksheets("Appraisal"): Set WsComs = ThisWorkbook.Worksheets("Comments")
Rem 2 FirstTwoDropDowns2
WsApp.Range("A2:A8").Validation.Delete
'WsApp.Range("A2:A8").Validation.Add Type:=xlValidateList, Formula1:="Communicating Effectively,Resolving Conflict,Sharing Information,Supporting Co - workers"
WsApp.Range("A2:A8").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A1").Value & "," & WsComs.Range("A11").Value & "," & WsComs.Range("A21").Value & "," & WsComs.Range("A31").Value & ""
WsComs.Range("C2:C8").Validation.Delete
'WsComs.Range("C2:C8").Validation.Add Type:=xlValidateList, Formula1:="Does Not Meet Expectation,Meets Expectation,Exceeds Expectation"
WsComs.Range("C2:C8").Validation.Add Type:=xlValidateList, Formula1:="" & WsComs.Range("A2").Value & "," & WsComs.Range("B2").Value & "," & WsComs.Range("C2").Value & ""
End Sub
AHDLadhlAHDAldhAH
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://i.imgur.com/rteyeHM.jpg
https://imgur.com/ex9FlRI https://i.imgur.com/ex9FlRI http://i.imgur.com/ex9FlRI
https://i.imgur.com/ex9FlRI.jpg
https://imgur.com/ZjEw5xy https://i.imgur.com/ZjEw5xy http://i.imgur.com/ZjEw5xy
https://i.imgur.com/ZjEw5xy.jpg
Code: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
https://i.imgur.com/bRPJELB.jpg
https://i.imgur.com/DHcaY0g.jpg
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
In support of this Thread post:
https://excelfox.com/forum/showthrea...ll=1#post15090
First attempt by siyab.
Code: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
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
https://i.imgur.com/BssuDnk.jpg
This macro will make the drop down lists appear in columns D an E when the cell is selected:
Code: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:
Code: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.
Code: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
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
In support of this Thread
https://excelfox.com/forum/showthrea...5110#post15110
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
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
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
https://i.imgur.com/Wvw7Ol1.jpg
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
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
https://i.imgur.com/wgdvdfy.jpg
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
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