PDA

View Full Version : [SOLVED] Find "PR" in column O then color cell and msgbox



Ike
06-10-2014, 07:14 AM
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
06-10-2014, 07:49 AM
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
06-10-2014, 07:59 AM
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
06-11-2014, 10:30 AM
Thanks everyone. They both work. :hi: