Drop Down List

On 26 Jul, 00:15, Gord Dibben gorddibbATshawDOTca wrote:
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

On Fri, 25 Jul 2008 11:58:53 -0700 (PDT), Pete
wrote:



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- Hide quoted text -

- Show quoted text -

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

On 26 Jul, 21:13, Pete wrote:
On 26 Jul, 00:15, Gord Dibben gorddibbATshawDOTca wrote:





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

On Fri, 25 Jul 2008 11:58:53 -0700 (PDT), Pete
wrote:

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- Hide quoted text -

- Show quoted text -

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 -

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

On Sat, 26 Jul 2008 13:29:01 -0700 (PDT), Pete
wrote:

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.

On 27 Jul, 01:34, Gord Dibben gorddibbATshawDOTca wrote:
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

On Sat, 26 Jul 2008 13:29:01 -0700 (PDT), Pete
wrote:



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.- Hide quoted text -

- Show quoted text -

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

On Sun, 27 Jul 2008 00:48:32 -0700 (PDT), Pete
wrote:

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.

On 27 Jul, 16:27, Gord Dibben gorddibbATshawDOTca wrote:
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

On Sun, 27 Jul 2008 00:48:32 -0700 (PDT), Pete
wrote:



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.- Hide quoted text -

- Show quoted text -

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

On Thu, 31 Jul 2008 03:03:49 -0700 (PDT), Pete
wrote:

On 27 Jul, 16:27, Gord Dibben gorddibbATshawDOTca wrote:
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

On Sun, 27 Jul 2008 00:48:32 -0700 (PDT), Pete
wrote:



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.- Hide quoted text -

- Show quoted text -

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

On 31 Jul, 17:25, Gord Dibben gorddibbATshawDOTca wrote:
Can probably combine both into one change event.

I will work on it later today.

Gord

On Thu, 31 Jul 2008 03:03:49 -0700 (PDT), Pete
wrote:



On 27 Jul, 16:27, Gord Dibben gorddibbATshawDOTca wrote:
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

On Sun, 27 Jul 2008 00:48:32 -0700 (PDT), Pete
wrote:

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.- Hide quoted text -

- Show quoted text -

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- Hide quoted text -

- Show quoted text -

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

On Fri, 1 Aug 2008 14:15:00 -0700 (PDT), Pete
wrote:

many thanks Gord, I look forward to seeing your code

Peter

On 1 Aug, 22:59, Gord Dibben gorddibbATshawDOTca wrote:
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

On Fri, 1 Aug 2008 14:15:00 -0700 (PDT), Pete
wrote:



many thanks Gord, I look forward to seeing your code

Peter- Hide quoted text -

- Show quoted text -

many thanks Gord will give it a try