Unable to run Multiple Procedures

CarolineGMartin90

New Member
Joined
Aug 7, 2017
Messages
13
Hi there,

I have two peices of code that work, however I am struggling to get them to run together. The first bit of code that changes numbers to words (i.e. "blood", "rust" etc.) is working, however I dont want users to be able to select multiple cells - only the one they are working in. However I am not able to get that aspect of my code to work in conjuntion with the other code. I have tried adding in "application.enableEvents" however I must be doing it wrong.

Any advice greatly appreciated!

Caroline

Code:
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False


Worksheet_SelectionChangeA Target
Worksheet_SelectionChangeB Target


Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChangeA(ByVal Target As Range)
Application.EnableEvents = False


Dim rng As Range
Dim Cell As Range


Set rng = Sheets("Sheet1").Range("F:F")


    For Each Cell In rng
        If Cell = "" Then
        Exit Sub
            Else
            If Cell = "N009011229028" Then
            Cell = "Blood"
                Else
                If Cell = "N009011229035" Then
                Cell = "Tissue"
                    Else
                    If Cell = "N009011229042" Then
                    Cell = "Bone"
                        Else
                        If Cell = "N009011229059" Then
                        Cell = "Rust"
                            Else
                            If Cell = "N009011229066" Then
                            Cell = "Sticky"
                                Else
                                If Cell = "N009011229073" Then
                                Cell = "Cement"
           
                  
        End If
            End If
                End If
                    End If
                        End If
                            End If
                                End If
                               
                           
    Next
Application.EnableEvents = True


End Sub



Private Sub Worksheet_SelectionChangeB(ByVal Target As Range)
Application.EnableEvents = False
If Selection.Cells.Count > 1 Then
MsgBox "Please select only one cell."
ActiveCell.Select
End If
Application.EnableEvents = True
End Sub
 
Last edited by a moderator:

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Try this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F:F")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Application.EnableEvents = False
If Target.Value = "N009011229028" Then Target.Value = "Blood"
If Target.Value = "N009011229035" Then Target.Value = "Tissue"
If Target.Value = "N009011229042" Then Target.Value = "Bone"
If Target.Value = "N009011229059" Then Target.Value = "Rust"
If Target.Value = "N009011229066" Then Target.Value = "Sticky"
If Target.Value = "N009011229073" Then Target.Value = "Cement"
Application.EnableEvents = True
End If
End Sub
 
Upvote 0
Hi there!

Many thanks for getting back to me so soon! I have given that a go, the changing of the codes to the assigned names works - however it has no affect on the user selection. In terms of the selection, I don't want users to be able to selec more than one cell throughout that sheet - not just in column F. And when they try select multiples (for instance if they wanted to select multiples and then delete multiple - which I dont want!) I want the message box to advise them that they can only select one.

The two codes I have written work when tested independently of one another. My issue comes when trying to have them work together, where it will just ignore the cell selection aspect of my code.

I am very confused with it all!

Hope that makes sense, and if you have any other suggestions for me to try please send them my way - really appreciate it!!

Many thanks,

Caroline
 
Upvote 0
Try this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F:F")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Application.EnableEvents = False
If Target.Value = "N009011229028" Then Target.Value = "Blood"
If Target.Value = "N009011229035" Then Target.Value = "Tissue"
If Target.Value = "N009011229042" Then Target.Value = "Bone"
If Target.Value = "N009011229059" Then Target.Value = "Rust"
If Target.Value = "N009011229066" Then Target.Value = "Sticky"
If Target.Value = "N009011229073" Then Target.Value = "Cement"
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then MsgBox "Your not allowed to select more then one cell": Exit Sub
End Sub
 
Upvote 0
Please take a minute to read the forum rules, especially regarding cross-posting, and then comply with them. Thanks. :)
 
Upvote 0
Thank you so much!! That works perfectly :) Really appreciate it!

Out of curiosity, do you have any understanding as to why my orginial code wasn't working? Is it because I was not using "Target"?

Again, many thanks!!
 
Upvote 0
Not really sure. I never write my scripts like that. But there are always more then one way to do things in Excel. Like I could use case statements but I just do mine my way. Someone may say their way will execute in .003 milliseconds faster.
Thank you so much!! That works perfectly :) Really appreciate it!

Out of curiosity, do you have any understanding as to why my orginial code wasn't working? Is it because I was not using "Target"?

Again, many thanks!!
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,254
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top