Want this code to work if any part of answer appears (Joe, Analyst, not just Analyst)

[Kusaywa]

I have a formula that pulls from a list of employees via their ID Number.
Employees that are Analysts have Analyst next to their name (Joe Jones, Analyst).
This code only works if the answer is "Analyst"
How can I get it to work with any employee that has Analyst in their Name?
This way I don't have to change the code for every employee.
Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
Set MyPlage = Range("A2:D4800")
      
    For Each cell In MyPlage
      ActiveSheet.Unprotect ("peteamy")
        Select Case cell.Value
          
         Case Is = "Analyst"
            cell.EntireRow.Font.ColorIndex = 3
          ActiveSheet.Protect ("peteamy")
        End Select
End Sub

 

[alansidman]

crosspost

Read this to understand crossposting, and then please edit your first post to include links to any and all cross-posts in any other forums (not just this site).

 

[Joe4]

Cross-posted here: http://www.ozgrid.com/forum/showthread.php?t=201102

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule #13 here: Forum Rules).

This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

For a more complete explanation on cross-posting, see here: Excelguru Help Site - A message to forum cross posters).

 

[L. Howard]

Try this.

Howard

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MyPlage As Range, c As Range
Set MyPlage = Range("A2:D4800")
'ActiveSheet.Unprotect ("peteamy")
      
   For Each c In MyPlage
      
     If InStr(c, "Analyst") > 0 Then
      c.EntireRow.Font.ColorIndex = 3
     End If
   
      Next
      
'ActiveSheet.Protect ("peteamy")
End Sub

 

[Kusaywa]

I'm getting an error here

c.EntireRow.Font.ColorIndex = 3

Also I crossposted this question.
http://www.ozgrid.com/forum/showthread.php?t=201102&goto=newpost**

 

[L. Howard]

Are you using c or Cell as the Dimmed Range.

Maybe post the full code you are using, if not exactly as the one I posted.

Howard

 

[Kusaywa]

I replaced my code with yours minus the option explicit and got the error. Does option explicit matter? In mine it uses cell but it's not "my" code, I found it and applied it. Mine does use cell, while yours uses c. I tried replacing c with cell and got the same error.

 

[L. Howard]

Post the entire code exactly what you are using.

Howard

 

[L. Howard]

I have to hit the road right now. Will check back latter today sometime.

Howard

 

[Kusaywa]

Here's my complete code.
You can see, I've got a lot going on.
But it all works, believe it or not.
Just trying to get the "name" thing worked out.

Private Sub Worksheet_Change(ByVal Target As Range)
Set MyPlage = Range("A2:D4800")
      
    For Each cell In MyPlage
      ActiveSheet.Unprotect ("peteamy")
        Select Case cell.Value
          
         Case Is = "Peter"
            cell.EntireRow.Font.ColorIndex = 3
          ActiveSheet.Protect ("peteamy")
        End Select
      Next
      
      
Dim rw As Long
rw = Target.Row
     If Range("B" & rw).Value <> "" Then
        ActiveSheet.Unprotect ("peteamy")
        Range("D" & rw).Locked = False
        ActiveSheet.Protect ("peteamy")
        'Remove locked property if B3's value is anything else or is deleted.
     Else
        ActiveSheet.Unprotect ("peteamy")
        Range("D" & rw).Locked = True
        'Optional, reprotect sheet
        ActiveSheet.Protect ("peteamy")
     End If

Dim Answ As String
Application.ScreenUpdating = False
Answ = MsgBox("Do you wish to confirm entry of this data?", vbOKCancel, "Confirm Change")
  If Answ <> vbOK Then
  Application.EnableEvents = False
  Target.ClearContents 'clear contents if cancel is pressed
  Application.EnableEvents = True
  Exit Sub
  End If
ActiveSheet.Unprotect "peteamy"
Target.Locked = True
ActiveSheet.Protect Password:="peteamy", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
 
 
Dim Sht As Worksheet
  If Target.Address = "$D$4800" Then
  
  Dim MyPath As String
    Dim MyFileName As String
    
    Application.DisplayAlerts = False
    MyPath = ThisWorkbook.Path
    MyFileName = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & (" ") & Format(Now, "dd-mm-yyyy hh-mm")
    
    If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
    If Not Right(MyFileName, 4) = ".xlsx" Then MyFileName = MyFileName & ".xlsx"
    
    ActiveSheet.Copy
    
    With ActiveWorkbook
    
        .SaveAs Filename:= _
            MyPath & MyFileName, _
            CreateBackup:=False
            
        .Close False
        
        Application.DisplayAlerts = True
        
        End With
  
  ActiveWorkbook.Unprotect "peteamy"
  Application.ScreenUpdating = False
  Sheets("Sheet2").Visible = True
    'Replace "Sheet1" with the name of the sheet to be copied.
    ActiveWorkbook.Sheets("Sheet2").Copy _
       after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
       Sheets("Sheet2").Visible = xlSheetVeryHidden
       
       
       Application.DisplayAlerts = False
On Error Resume Next
ActiveSheet.Previous.Previous.Delete
ActiveWorkbook.Protect "peteamy"
   End If
   
   On Error Resume Next
    Application.EnableEvents = False
    If Not Target.Cells.CountLarge > 1 Then
        
        If Not Intersect(Target, Columns(4)) Is Nothing Then
            Target.Offset(1, -2).Select
        End If
    End If
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
       
       End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 CurrentRow = ActiveCell.Row
If CurrentRow = 1 Then Exit Sub
 CurrentCol = ActiveCell.Column
If Cells(CurrentRow - 1, CurrentCol).Value = 0 Then
 MsgBox ("Please Do Not Skip Rows")
 ActiveCell.Offset(-1, 0).Activate
End If
Dim MyRange As Range, lr As Long
lr = Cells(Rows.Count, "B").End(xlUp).Row
Set MyRange = Range("B2:B" & lr)
For Each cell In MyRange
If cell.Value <> "" And cell.Offset(0, 2).Value = "" Then
MsgBox "Your ID Number is Required"
Application.EnableEvents = False
cell.Offset(0, 2).Select
Application.EnableEvents = True
Exit Sub
End If
Next cell
End Sub