debug error?

[deletedalien]

hi all.

so i have this code, that is supposed to change the text to uppercase if written in lowercase and give an error message if the word "drop" is typed in, BUT this should only apply to column "B" and it gives me an error when i change any other cells (in any other columns)

in addition in want to make just one person in the copmany be able to type DROP in column B <-- is this possible?

anywho here is my code and any help is greatly appreciated

Private Sub Worksheet_Change(ByVal Target As RANGE)
Application.DisplayAlerts = False
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, RANGE("B:B")) Is Nothing Then
        Application.EnableEvents = False
        Target = UCase(Target)
        Application.EnableEvents = True
    End If
    On Error GoTo 0
 
   'Do nothing if more than one cedll is changed or content deleted
   If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
 
If Intersect(Target, RANGE("B:B")) = "DROP" Then
            'Stop any possible runtime errors and halting code
            On Error Resume Next
                'Turn off ALL events so the Target * 2 does not put the code into a loop.
                Application.EnableEvents = False
                Target = ClearContents
                'Turn events back on
                Application.EnableEvents = True
            'Allow run time errors again
 
            MsgBox "Cannot Select Drop", vbCritical, "Invalid selection"
 
            On Error GoTo 0
        End If
 
    End Sub

Thanx in advance.

 

[bensonsearch]

Hi,
im not to sure why it is picking up other cells but your user issue can be done (assuming you all have different log ins).

dim asd as string
 
asd = (Environ$("Username"))

the above will store the windows log in into asd. then you can test it.

if asd <> "user that has access" then
'code when check fails
else
'code when correct user is entered
end if

 

[deletedalien]

BUMP

anyone?

 

[shg]

One way:

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Column <> 2 Then Exit Sub
        If .Cells.Count > 1 Then Exit Sub
        If .HasFormula Then Exit Sub
 
        On Error GoTo Oops
        Application.EnableEvents = False
        .Value = UCase(.Value)
 
        If .Value = "DROP" And Environ("username") <> "Bob" Then
            .Select
            .ClearContents
            MsgBox "Only Bob can select DROP", vbCritical, "Invalid selection"
        End If
    End With
 
Oops:
    Application.EnableEvents = True
End Sub

 

[deletedalien]

One way:

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Column <> 2 Then Exit Sub
        If .Cells.Count > 1 Then Exit Sub
        If .HasFormula Then Exit Sub
 
        On Error GoTo Oops
        Application.EnableEvents = False
        .Value = UCase(.Value)
 
        If .Value = "DROP" And Environ("username") <> "Bob" Then
            .Select
            .ClearContents
            MsgBox "Only Bob can select DROP", vbCritical, "Invalid selection"
        End If
    End With
 
Oops:
    Application.EnableEvents = True
End Sub

AWESOMENES does not even begin to describe you!

THIS WORKED BETTER THAN PERFECT!!!!!


Thank you so so so VERY MUCH!!!!!!

 

[shg]

Yer welcome.

 

[deletedalien]

so turns out i need to add some more stuff.

can i do this?

Private Sub Worksheet_Change(ByVal Target As RANGE)
     
    With Target
        If .Column <> 2 Then Exit Sub
        
        Else: If .Column <> 31 Then GoTo ok1
        
        
        If .Cells.Count > 1 Then Exit Sub
        If .HasFormula Then Exit Sub
 
        On Error GoTo Oops
        Application.EnableEvents = False
        .Value = UCase(.Value)
 
        If .Value = "DROP" And Environ("username") <> "gsmalls" Then
            .Select
            .ClearContents
            MsgBox "Only Gregg Smalls can select DROP", vbCritical, "Invalid selection"
        End If
    
             
    End With
 
Oops:
    Application.EnableEvents = True
    
ok1:
    
    With Target
        If .Column <> 31 Then Exit Sub
        If .Cells.Count > 1 Then Exit Sub
        If .HasFormula Then Exit Sub
        
        End If
 
        On Error GoTo Oops2
        If .Value = "" And Environ("username") <> "gsmalls" Then
            .Select
            .ClearContents
            
            ActiveCell.Offset(0, -29).Select
           ActiveCell.Formula = "Drop"
           End If
    End With
 
Oops2:
    Application.EnableEvents = True
    
End Sub

i need to enable the user Gsmalls be the only one to modify in any way column "AE" and IF any cell in that column gets modified then it will return to the cell in column b and thange the text to "DROP".

Sorry about these changes but they happen as they go,


Also (this is a hard one) is there a way to add more than one user?
if not possible then thats ok.

Thanx again.

 

[deletedalien]

Bump!

Thanx