To upload a workbook, click reply then add your few words, scroll down past the submit button and you will see the Manage Attachments button, this is where you get to add files for upload, if you have any trouble please use this Contact Us link or the one at the bottom of the any page.

incisivekeith · #1 (**permalink**) 23rd November 2009, 01:44 AM

------ Register to get rid of these "In Post" ads! ------

I am fairly new to VB and don't know how to code in VB. I want to accomplish multiple selection from a dropdown list in Excel and also add items in the dropdown list by entering them in the dropdown menu cell. I have the following independent codes to accomplish this:

Code for multiple selection code -

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  If Target.Column = 5 Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      Target.Value = oldVal _
        & ", " & newVal
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

Code for adding items in the dropdown menu by typing them in the cell -
'Original Source: The Code Cage Forums http://www.thecodecage.com/forumz/members-excel-vba-programming/156375-two-independent-vbulletin-codes-not-working-harmony.html#post566478

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("A1")) Is Nothing Then
    If Application.WorksheetFunction.CountIf(Range("Options"), [A1]) = 0 Then
        Range("AA" & Rows.Count).End(xlUp).Offset(1, 0).Value = Range("A1").Value
        Columns("AA:AA").Sort Key1:=Range("AA1"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    End If
End If

End Sub

When I paste both these codes after opening "View Code" for a sheet, I am not able to run the data validation list on that sheet as it results into compilation errors. How can I edit the codes to have the functionality I intend to achieve? Even better, could someone help me figure out a way for using these codes for the whole workbook instead of pasting them for each worksheet, as I have 40 worksheets and many workbooks? I am a newbie, so I would greatly appreciate detailed instructions. Thank you.

Simon Lloyd · #2 (**permalink**) 23rd November 2009, 02:19 AM

------ Register to get rid of these "In Post" ads! ------

Why not add a workbook?
Providing a workbook will not only get you your answer quicker but will better illustrate your problem, usually when we can see your data (it can be dummy data but must be of the same type) and your structure it is far easier for us to give you a tailored, workable answer to your query

Attachments.

Information

To upload a workbook, click reply then add your few words, scroll down past the submit button and you will see the Manage Attachments button, this is where you get to add files for upload, if you have any trouble please use this Contact Us link or the one at the bottom of the any page.

that said, this code is just your 2 codes put together in a WORKBOOK event code module, get rid of your other worksheet code and save this code as instructed:

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
''Code for multiple selection code
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  If Target.Column = 5 Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      Target.Value = oldVal _
        & ", " & newVal
      End If
    End If
  End If
End If
exitHandler:
  Application.EnableEvents = True
''Code for adding items in the dropdown menu by typing them in the cell
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A1")) Is Nothing Then
    If Application.WorksheetFunction.CountIf(Range("Options"), [A1]) = 0 Then
        Range("AA" & Rows.Count).End(xlUp).Offset(1, 0).Value = Range("A1").Value
        Columns("AA:AA").Sort Key1:=Range("AA1"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    End If
End If
End Sub

How to Save a Workbook Event Macro
'Original Source: The Code Cage Forums http://www.thecodecage.com/forumz/members-excel-vba-programming/156375-two-independent-vbulletin-codes-not-working-harmony.html#post566492

Help

1. Copy the macro above placing the cursor to the left of the code box hold the CTRL & Left Click, then Right Click selected code and Copy.
2. Open your Workbook and Right Click on any Worksheet's Name Tab
3. Left Click on View Code in the pop up menu.
4. Press ALT+F11 keys to open the Visual Basic Editor.
5. Press CTRL+R keys to shift the focus to the Project Explorer Window
6. Press the Down Arrow Key until ThisWorkbook is highlighted in blue.
7. Press the Enter key to move the cursor to the Code Window
8. Paste the macro code using CTRL+V
9. Save the macro in your Workbook using CTRL+S

incisivekeith · #3 (**permalink**) 23rd November 2009, 02:43 AM

------ Register to get rid of these "In Post" ads! ------

I apologize for not attaching the workbook. I pasted the code that you provided in ThisWorkbook object, but it doesn't achive what I want to achieve, most probably due to my lack of VBA knowledge. I want to have the multiple selection and adding items in the dropdown menu functions work, where the code is for the whole workbook and the range is located on a sheet (Sheet2) other than the current sheet (Sheet1). I have the dropdown menu in cell A1 on Sheet1 and the list or the range from where it is pulling data is on Sheet2 as "MyRange." I want to keep the range on a separate sheet as I want to keep a sheet just for lists that I will be using to pull data in 40 sheets in the same workbook. Could you please take a look and tell me what I am doing wrong? I greatly appreciate it.

Simon Lloyd · #4 (**permalink**) 23rd November 2009, 05:04 AM

------ Register to get rid of these "In Post" ads! ------

Keith, i'm at work and off home to bed in a couple of hours (it's been a long night!) so i wont get chance to look at it for a good few hours but will try and get to it when i get up

incisivekeith · #5 (**permalink**) 23rd November 2009, 05:58 PM

------ Register to get rid of these "In Post" ads! ------

Quote:

Originally Posted by Simon Lloyd

Keith, i'm at work and off home to bed in a couple of hours (it's been a long night!) so i wont get chance to look at it for a good few hours but will try and get to it when i get up

Thank you. I appreciate it. I have been able to find some more help and am pasting the final code I have. Now I want to edit the code so that I can make the application to all the sheets, instead of applying just to Sheet1 in the following line in the code:

I want to edit the code attached so that I can include more columns in addition to A1 columns of all sheets, not just Sheet1. My Excel template would have several named dynamic lists on one sheet (sheet2 in this example)and those lists would be pulled by many dropdown menus based on those lists in several cells in different worksheets. As an example, I have two lists in colums A and C in Sheet2. I have two dropdown menus in Sheet1 in cell A1 and E15. The code I have so far allows multiple selection only from the range in column A of sheet2 in cell A1 of sheet1; it doesn't allow those functionality for the list in column C of sheet2 in cell E15 of sheet1. Again, as I mentioned, I am struggling to have the multiple selection and add items to the dropdown menu functionality available in any sheet on any cell, not just sheet1. I hope I have defined the problem clearly. Thank you.

incisivekeith · #6 (**permalink**) 24th November 2009, 04:16 AM

------ Register to get rid of these "In Post" ads! ------

I thought I had it in now, with a new code, but I came across another problem. In the part of the code where it adds to the dropdown menu in a particular cell, how would I edit it to have it so that I select a range of cells in a particular column (each cell in that range has a dropdown menu) instead of selecting only one cell. For example, in the code, "Activesheet.Range("A1")," selects A1 cell of the active sheet, but I want to select a certain range of column C (e.g. C11:C35). How would I accomplish that? In the code, I inserted Activesheet.Range("C11:C35") but the addition of new items in the dropdown menu does not occur and the list also does not get updated with the new item. What am I doing wrong? I am attaching the actual document I am working on. I highly appreciate your help. Thank you.
--- Automerged consecutive post before response ---
I figured out the solution for the problem in my post before this one. Now I have a new requirement, if someone can please help me, as I have a deadline tomorrow for sure.

The new items I add in the menu will need to be recognized as new additions to the list later on. Is there a way I can code the new additions to the dropdown menu as bold fonts or do something to differentiate them from the items already existing in the list? Thank you again.
'Original Source: The Code Cage Forums http://www.thecodecage.com/forumz/members-excel-vba-programming/156375-two-independent-vbulletin-codes-not-working-harmony.html#post567614

Keith.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

The Following User Says Thank You to Simon Lloyd For This Useful Post:
incisivekeith (23rd November 2009)

Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)