sarahrb1989
New Member
- Joined
- Dec 15, 2017
- Messages
- 30
I don't know very much about coding or the Excel developer tool. 
I have a spreadsheet for work that has demographic information that needs to be input. Currently, I have a combo box using data validation lists that does this for me. Here is the code I currently have in place which changes my selection to a "code". For Example, I choose Male and it changes to M.
I have one column in the spreadsheet that requires the option of selecting multiple items from the drop down menu and putting them in the same cell together separated by a comma. I have a few different options of code from the same website that do something similar. However, none of these change the item selected to a "code" version.
For example, I choose African American and Caucasian. I would like the cell to read AA, Cauc.
Is there a way to alter any of these codes (including the above) to do this?
Here is the sample code for the other options:
http://blog.contextures.com/archives/2014/01/21/multiple-selection-drop-down-with-codes/
http://www.contextures.com/excel-data-validation-multiple.html
Please let me know if any additional information is needed. My preference would be to alter the first code for the specific column I need to allow for multiple selections in the same cell that use a "code" version of the selection.
I have a spreadsheet for work that has demographic information that needs to be input. Currently, I have a combo box using data validation lists that does this for me. Here is the code I currently have in place which changes my selection to a "code". For Example, I choose Male and it changes to M.
Code:
Option Explicit
' Developed by Contextures Inc.
' [URL="http://www.contextures.com"]www.contextures.com[/URL]
Private Sub Combobox2_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
'Hide combo box and move to next cell on Enter and Tab
Select Case KeyCode
Case 9
ActiveCell.Offset(0, 1).Activate
Case 13
ActiveCell.Offset(1, 0).Activate
Case Else
'do nothing
End Select
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Set ws = ActiveSheet
Set wsList = Sheets("Demographics Options")
Cancel = True
Set cboTemp = ws.OLEObjects("Combobox2")
On Error Resume Next
With cboTemp
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
.ListFillRange = str & "_Codes"
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Application.EnableEvents = False
Application.ScreenUpdating = False
If Application.CutCopyMode Then
'allows copying and pasting on the worksheet
GoTo errHandler
End If
Set cboTemp = ws.OLEObjects("ComboBox2")
On Error Resume Next
With cboTemp
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Object.Value = ""
End With
errHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
End SubI have one column in the spreadsheet that requires the option of selecting multiple items from the drop down menu and putting them in the same cell together separated by a comma. I have a few different options of code from the same website that do something similar. However, none of these change the item selected to a "code" version.
For example, I choose African American and Caucasian. I would like the cell to read AA, Cauc.
Is there a way to alter any of these codes (including the above) to do this?
Here is the sample code for the other options:
http://blog.contextures.com/archives/2014/01/21/multiple-selection-drop-down-with-codes/
Code:
Option Explicit
' Developed by Contextures Inc.
' [URL="http://www.contextures.com"]www.contextures.com[/URL]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lCode As Long
Dim wsList As Worksheet
Dim rngList As Range
Dim rngListID As Range
If Target.Count > 1 Then GoTo exitHandler
Set wsList = ActiveSheet
Set rngList = wsList.Range("NumWordList")
Set rngListID = wsList.Range("NumWordID")
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 = 3 Then
If oldVal = "" Then
'do nothing
lCode = rngListID.Range("A1") _
.Offset(Application. _
WorksheetFunction _
.Match(Target.Value, _
rngList, 0) - 1, 0)
Target.Offset(0, 1).Value = lCode
Else
If newVal = "" Then
'do nothing
Target.Offset(0, 1).ClearContents
Else
lCode = rngListID.Range("A1") _
.Offset(Application. _
WorksheetFunction _
.Match(Target.Value, _
rngList, 0) - 1, 0)
Target.Value = oldVal _
& ", " & newVal
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value _
& ", " & lCode
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Subhttp://www.contextures.com/excel-data-validation-multiple.html
Code:
Option Explicit
' Developed by Contextures Inc.
' [URL="http://www.contextures.com"]www.contextures.com[/URL]
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lType As Long
Dim strList As String
Application.EnableEvents = False
On Error Resume Next
lType = Target.Validation.Type
On Error GoTo exitHandler
If lType = 3 Then
'if the cell contains a data validation list
Cancel = True
strList = Target.Validation.Formula1
strList = Right(strList, Len(strList) - 1)
strDVList = strList
frmDVList.Show
End If
exitHandler:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strSep As String
strSep = ", "
Application.EnableEvents = False
On Error Resume Next
If Target.Count > 1 Then GoTo exitHandler
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
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If newVal = "" Then
'do nothing
Else
If oldVal = "" Then
Target.Value = newVal
Else
Target.Value = oldVal & strSep & newVal
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
