Hi all

Hoping someone can help out. I want to paste the values in the entire row
based on the contents of one cell in that row.

Column Q is "Approved Status" with formula that is either Current or
Expired. When the formula changes to expired, the user activates a macro to
send an email with the expired cases. Expired then changes to Emailed. I
would like all the cells in that row to then be copied and pasted with their
values rather than the formula that exist in the other cells. This is the
macro I have so far - thanks to Ron DeBruin:

Sub Mail_Selection_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007

ActiveSheet.Unprotect
Selection.AutoFilter Field:=16, Criteria1:="expired"
Rows("2:2").Select
Range("B2").Activate
Selection.EntireRow.Hidden = True


Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng =
Sheets("Approvals").Range("b3:q20").SpecialCells(x lCellTypeVisible)

On Error GoTo 0


If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "CRCs Requiring New Approvals - Please Action"
.HTMLBody = RangetoHTML(rng)
.Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

Selection.AutoFilter Field:=16
Cells.Select
Range("B3").Activate
Selection.EntireRow.Hidden = False
Rows("1:1").Select
Range("B1").Activate
Selection.EntireRow.Hidden = True

ActiveSheet.Unprotect
Range("B3:U13").Select
Selection.sort Key1:=Range("Q4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal



n = Cells(Rows.Count, "q").End(xlUp).Row
For i = 1 To n
With Cells(i, "q")
If .Value = "Expired" Then .Value = "Emailed"
End With
Next


ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowFiltering:=True
End Sub