Drop Down List

  • Thread starter Thread starter Pete
  • Start date Start date
P

Pete

is it possible to choose an item from a dropdown list which will enter
a different value other than that chosen. Why I want to do this is as
follows:

We have 20 steps in our Process and each one is assigned a number e.g

1 = Forming
2 = Drying
3 = Paper
4 = Cutter

etc etc

I would like to display the Text in a Drop down for that Cell but
enter the corresponding Number into the Cell. If I chose Drying I
would like to see the number 2 appear in the Cell, or if I chose
Cutter I would like the Number 4 to be entered in the Cell.

Thanks

Pete
 
Use two cells:

The first cell will have a data validation pull-down to enter the text.
The second cell will have a VLOOKUP() formula to lookup the correct number.
 
Use two cells:

The first cell will have a data validation pull-down to enter the text.
The second cell will have a VLOOKUP() formula to lookup the correct number.
--
Gary''s Student - gsnu2007j









- Show quoted text -
Click to expand...

Sheets is already designed, I only have one Cell to work with
 
To enter the number in the same cell use this example sheet event code.

Private Sub Worksheet_Change(ByVal Target As Range)
Set r = Range("A1") 'edit to suit the DV cell(s)
If Intersect(Target, r) Is Nothing Then
Exit Sub
End If
vals = Array("A", "B", "C", "D", "E", "F") 'edit to suit
nums = Array(1, 2, 3, 4, 5, 6) 'add more numbers
For Each rr In r
ival = 0
For i = LBound(vals) To UBound(vals)
If UCase(rr.Value) = vals(i) Then
ival = nums(i)
End If
Next
If ival > 0 Then
rr.Value = ival
End If
Next
End Sub


Gord Dibben MS Excel MVP
 
To enter the number in the same cell use this example sheet event code.

Private Sub Worksheet_Change(ByVal Target As Range)
Set r = Range("A1")  'edit to suit the DV cell(s)
If Intersect(Target, r) Is Nothing Then
    Exit Sub
End If
vals = Array("A", "B", "C", "D", "E", "F") 'edit to suit
nums = Array(1, 2, 3, 4, 5, 6)  'add more numbers
For Each rr In r
    ival = 0
    For i = LBound(vals) To UBound(vals)
        If UCase(rr.Value) = vals(i) Then
            ival = nums(i)
        End If
    Next
    If ival > 0 Then
    rr.Value = ival
    End If
Next
End Sub

Gord Dibben  MS Excel MVP







- Show quoted text -
Click to expand...

Gord, you are THE man, perfect solution, thank you
 
To enter the number in the same cell use this example sheet event code.

Private Sub Worksheet_Change(ByVal Target As Range)
Set r = Range("A1")  'edit to suit the DV cell(s)
If Intersect(Target, r) Is Nothing Then
    Exit Sub
End If
vals = Array("A", "B", "C", "D", "E", "F") 'edit to suit
nums = Array(1, 2, 3, 4, 5, 6)  'add more numbers
For Each rr In r
    ival = 0
    For i = LBound(vals) To UBound(vals)
        If UCase(rr.Value) = vals(i) Then
            ival = nums(i)
        End If
    Next
    If ival > 0 Then
    rr.Value = ival
    End If
Next
End Sub

Gord Dibben  MS Excel MVP







- Show quoted text -
Click to expand...

Gord,

A similar problem, I would like to enter a value in the C11 and
convert it to another after the Value has been entered. E.g If I enter
100 in C11 I would like to Divide it by the Value I have in C17 under
the Change Event Procedure. I would need to do this in the full Range
e.g Divide E11 by E17 and G11 by G17 etc etc. upto AK11/AK17

CAn yuo show me how to adapt your previous code to do this too?

Thanks

Pete
 
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C11,E11,G11,I11,K11" 'add cells to suit
Dim cell As Range
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Value <> "" Then
.Value = .Value * .Offset(6, 0).Value
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub


Gord
 
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C11,E11,G11,I11,K11"     'add cells to suit
Dim cell As Range
    On Error GoTo ws_exit
    Application.EnableEvents = False
    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
        With Target
        If .Value <> "" Then
            .Value = .Value * .Offset(6, 0).Value
            End If
        End With
    End If
ws_exit:
    Application.EnableEvents = True
End Sub

Gord




- Show quoted text -
Click to expand...

Thanks Gord, I will give it a try.

I now have pieces of code in the Change Sub and they seem to affect
each other. Can this piece of code you've just done for me work along
side the earlier one you did?

Pete
 
Thanks Gord, I will give it a try.

I now have pieces of code in the Change Sub and they seem to affect
each other. Can this piece of code you've just done for me work along
side the earlier one you did?

Pete- Hide quoted text -

- Show quoted text -
Click to expand...

Gord, perfect again exacly what I want. If I post all the code I have
in the Change Event sub, could you tidy it up for me so it works
properly. I can get the ones you have done for me to work seperately,
but when they are both in only the first one works. I also have Chip
Pearson's Quick Time Entry code in there to and I could od with all 3
working.

thanks in advance

Pete
 
I am surprised you are not getting error messages about "ambiguous name
detected"

More than one Worksheet_Chamge event in a sheet is not allowed.

There are ways to work around it but I'm not the guy to be talking to.

Browse through Chip's pages on Events to get a better idea of what's
available.

http://www.cpearson.com/excel/Events.aspx

And check out David McRitchie's site

http://www.mvps.org/dmcritchie/excel/event.htm

Gord



- Show quoted text -
Click to expand...

I only have the one Worksheet_Change Event Sub but would like the 2
pieces of code you have done for me to be in it. Could you combine the
2 as below as the way I have it I think the first exit's before the
second has been done.

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C11,E11,G11,I11,K11" 'add cells to
suit
Dim cell As Range
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Value <> "" Then
.Value = .Value * .Offset(6, 0).Value
End If
End With
End If
ws_exit:
Application.EnableEvents = True

Set r = Range("A1") 'edit to suit the DV cell(s)
If Intersect(Target, r) Is Nothing Then
Exit Sub
End If
vals = Array("A", "B", "C", "D", "E", "F") 'edit to suit
nums = Array(1, 2, 3, 4, 5, 6) 'add more numbers
For Each rr In r
ival = 0
For i = LBound(vals) To UBound(vals)
If UCase(rr.Value) = vals(i) Then
ival = nums(i)
End If
Next
If ival > 0 Then
rr.Value = ival
End If
Next

End Sub

Pete
 
A bit cumbersome but can be done thisaway

Place these two events in the worksheet..........can have more than one if
events are different.

After you select an item from A1 dropdown just double-click on A1 to effect
the change.


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Set r = Range("A1") 'edit to suit the DV cell(s)
If Intersect(Target, r) Is Nothing Then
Exit Sub
End If
vals = Array("A", "B", "C", "D", "E", "F") 'edit to suit
nums = Array(1, 2, 3, 4, 5, 6) 'add more numbers
For Each rr In r
ival = 0
For i = LBound(vals) To UBound(vals)
If UCase(rr.Value) = vals(i) Then
ival = nums(i)
End If
Next
If ival > 0 Then
rr.Value = ival
End If
Cancel = True
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C11,E11,G11,I11,K11" 'add cells to suit
Dim cell As Range
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Value <> "" Then
.Value = .Value * .Offset(6, 0).Value
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub


Gord
 
A bit cumbersome but can be done thisaway

Place these two events in the worksheet..........can have more than one if
events are different.

After you select an item from A1 dropdown just double-click on A1 to effect
the change.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Set r = Range("A1")  'edit to suit the DV cell(s)
If Intersect(Target, r) Is Nothing Then
    Exit Sub
End If
vals = Array("A", "B", "C", "D", "E", "F") 'edit to suit
nums = Array(1, 2, 3, 4, 5, 6)  'add more numbers
For Each rr In r
    ival = 0
    For i = LBound(vals) To UBound(vals)
        If UCase(rr.Value) = vals(i) Then
            ival = nums(i)
        End If
    Next
    If ival > 0 Then
    rr.Value = ival
    End If
    Cancel = True
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C11,E11,G11,I11,K11" 'add cells to suit
Dim cell As Range
    On Error GoTo ws_exit
    Application.EnableEvents = False
    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
        With Target
        If .Value <> "" Then
            .Value = .Value * .Offset(6, 0).Value
            End If
        End With
    End If

ws_exit:
    Application.EnableEvents = True
End Sub

Gord



- Show quoted text -
Click to expand...

Thanks Gord for the time you have put in on this so far.

I take it then, that you can't just do an If Then Else depending on
the Range the Cell is currently in?

Peter
 
Can probably combine both into one change event.

I will work on it later today.

Gord






- Show quoted text -
Click to expand...

many thanks Gord, I look forward to seeing your code

Peter
 
I think this is it.

Tested on both the DV drowdown selection and the multiply by Offset(6, 0)
codition.

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C11,E11,G11,I11,K11" 'add cells to suit
Dim cell As Range
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Value <> "" Then
.Value = .Value * .Offset(6, 0).Value
End If
End With
End If
Application.EnableEvents = True

Set r = Range("A1") 'edit to suit the DV cell(s)
If Intersect(Target, r) Is Nothing Then
Exit Sub
End If
Application.EnableEvents = False
vals = Array("A", "B", "C", "D", "E", "F") 'edit to suit
nums = Array(1, 2, 3, 4, 5, 6) 'add more numbers
For Each rr In r
ival = 0
For i = LBound(vals) To UBound(vals)
If UCase(rr.Value) = vals(i) Then
ival = nums(i)
End If
Next
If ival > 0 Then
rr.Value = ival
End If
Next
ws_exit:
Application.EnableEvents = True

End Sub


Gord
 
I think this is it.

Tested on both the DV drowdown selection and the multiply by Offset(6, 0)
codition.

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C11,E11,G11,I11,K11"     'add cells to suit
Dim cell As Range
    On Error GoTo ws_exit
    Application.EnableEvents = False
    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
        With Target
        If .Value <> "" Then
            .Value = .Value * .Offset(6, 0).Value
            End If
        End With
    End If
    Application.EnableEvents = True

Set r = Range("A1")      'edit to suit the DV cell(s)
If Intersect(Target, r) Is Nothing Then
    Exit Sub
End If
Application.EnableEvents = False
vals = Array("A", "B", "C", "D", "E", "F") 'edit to suit
nums = Array(1, 2, 3, 4, 5, 6)  'add more numbers
For Each rr In r
    ival = 0
    For i = LBound(vals) To UBound(vals)
        If UCase(rr.Value) = vals(i) Then
            ival = nums(i)
        End If
    Next
    If ival > 0 Then
    rr.Value = ival
    End If
Next
ws_exit:
    Application.EnableEvents = True

End Sub

Gord




- Show quoted text -
Click to expand...

many thanks Gord will give it a try
 
Back
Top