Highlight a row based on cell content

needhelptdot

New Member
Joined
Sep 8, 2011
Messages
13
Hi,

I am writing a code that will copy outlook emails to an excel spreadsheet. I have figured out how to get the emails into excel but I need help to highlight a row based on what is in the column 'Subject'. Specifically, if the subject of an email is 'Re: *', I need the entire row to be highlighted (color doesn't matter). Here is what I have so far:

Sub ExportToExcel()

On Error GoTo ErrHandler

Dim appExcel As Excel.Application

Dim wkb As Excel.Workbook

Dim wks As Excel.Worksheet

Dim rng As Excel.Range

Dim strSheet As String

Dim strPath As String

Dim intRowCounter As Integer

Dim intColumnCounter As Integer

Dim msg As Outlook.MailItem

Dim nms As Outlook.NameSpace

Dim fld As Outlook.MAPIFolder

Dim itm As Object

strSheet = "OutlookItems" & Format(Date, "dd-mm-yyyy") & ".xls"

strPath = "C:\Documents and Settings\atret2\Outlook to Excel\"

strSheet = strPath & strSheet

Debug.Print strSheet
'Select export folder
Set nms = Application.GetNamespace("MAPI")

Set fld = nms.PickFolder
'Handle potential errors with Select Folder dialog box.
If fld Is Nothing Then
MsgBox "There are no msgs"
End If
'Open and activate Excel workbook.
Set appExcel = CreateObject("Excel.Application")

appExcel.Workbooks.Open (strSheet)

Set wkb = appExcel.ActiveWorkbook

Set wks = wkb.Sheets(1)

wks.Activate

appExcel.Application.Visible = True
'Copy field items in mail folder.

For Each itm In fld.Items

intColumnCounter = 1

Set msg = itm

intRowCounter = intRowCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.To

intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.SenderEmailAddress

intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.Subject

intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = Format(msg.SentOn, "MM-DD")

intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = Format(msg.ReceivedTime, "MM-DD")


Next itm

Set appExcel = Nothing

Set wkb = Nothing

Set wks = Nothing

Set rng = Nothing

Set msg = Nothing

Set nms = Nothing

Set fld = Nothing

Set itm = Nothing

Exit Sub

ErrHandler: If Err.Number = 1004 Then

MsgBox strSheet & " doesn't exist"

Else

MsgBox Err.Number & "; Description: "

End If

Set appExcel = Nothing

Set wkb = Nothing

Set wks = Nothing

Set rng = Nothing

Set msg = Nothing

Set nms = Nothing

Set fld = Nothing

Set itm = Nothing

End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
It seems to me it would be easier to highlight the row using conditional formatting, found on the home tab of your ribbon. Just click on Conditional Formatting and then select contains text. In the box, type RE: and choose your color. Is that what you are trying to do?
 
Upvote 0
Yes but I need this to be automated. End goal is to run the macro through outlook and end up with a spreadsheet which shows all emails but highlights the ones that are replies to previous emails
 
Upvote 0
If your data to be evaluated is always in the same row, wouldn't it be automatic? Have you used conditional formatting before? Once you set it, it will change colors based on your criteria, you only have to do it once. If you MUST have a macro, I am of no use. lol
 
Upvote 0
I found this, maybe what you were looking for.

Sub Check_Range_Value()
Dim rnArea As Range
Dim rnCell As Range

Set rnArea = Range("A1:B11")

For Each rnCell In rnArea
With rnCell
If Not IsError(.Value) Then
Select Case .Value
Case "R"
.Interior.ColorIndex = 45
Case "Y"
.Interior.ColorIndex = 20
End Select
End If
End With
Next

End Sub
 
Upvote 0
i get an error '1004'...method 'range' of object '_global' failed. Not sure what to do because i'm really new to this
 
Upvote 0

Forum statistics

Threads
1,224,586
Messages
6,179,719
Members
452,939
Latest member
WCrawford

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top