Find "PR" in column O then color cell and msgbox

[Ike]

Hello All,

I am in need of Private Sub code that will do three things...

1. Detect "PR" in column O (15)

If in column O "PR" is pasted then ...

a. Msgbox ("Alert")
b. Color the cell - Interior.ColorIndex = 46 'Orange



2. Capitalizes the first letter of words in columns J - N

3. Make the email address in column T to be all lower case


Thank you in advance

[ranman256]

dim c as long
  'scan the col A
range("A2").select
While ActiveCell.Value <> ""
      'set col T
   ActiveCell.offset(0,19).Value = LCase(ActiveCell.offset(0,19).Value)
      'COL O
   IF ActiveCell.offset(0,14).Value = "OP" THEN  
         ActiveCell.offset(0,14).Interior.ColorIndex = 46  'Orange
        ' MSGBOX "ALERT"
  END IF

    for c = 9 to 13   'j thru n set proper case
       ActiveCell.offset(0,c).Value = Application.WorksheetFunction.Proper(ActiveCell.offset(0,c).Value)
    next

   ActiveCell.Offset(1, 0).Select  'next row
Wend

[mancubus]

Sub find_color_alert()
    
    Dim fCell As Range
    Dim j As Long
    Dim msg As String, fAddress As String
    
    msg = "PR found in cells:" & vbLf
    
    With ActiveSheet
        Set fCell = .Columns(15).Find("PR", , , xlWhole) 'full match
        'Set fCell = .Columns(15).Find("PR", , , xlPart) 'partial match
        If Not fCell Is Nothing Then
            fAddress = fCell.Address
            Do
                fCell.Interior.ColorIndex = 46
                For j = 10 To 14 'col J thru col N
                    .Cells(fCell.Row, j).Value = Application.Proper(.Cells(fCell.Row, j).Value)
                Next
                .Cells(fCell.Row, 20).Value = LCase(.Cells(fCell.Row, 20).Value)
                msg = msg & fCell.Address(0, 0) & vbLf
                Set fCell = .Columns(15).FindNext(fCell)
            Loop While Not fCell Is Nothing And fCell.Address <> fAddress
            MsgBox msg
        End If
    End With
End Sub

[Ike]

Thanks everyone. They both work.