CODEWITHSUNDEEP
vbaexcelif-statementforeach
Rusty
Rusty

Reputation: 384

'For Each' loop keeps looping past 'If' condition

I am pulling emails from Outlook into Excel with VBA, comparing the subject line of the email with a range of cells on another sheet. I am using a For Each loop to achieve this but it seems as though when my if condition is met, it keeps going so it doesn't post the result that I want. It seems to loop through all of the cells in the range I have defined but then even when it meets my if condition, it keeps going and ends up being blank.

Here I am defining my ranges:

Dim rRng As Range, cel As Range
Set rRng = Sheet2.Range("A2:A1218")

Here is my For Each loop:

oRow = 1
    For iRow = 1 To Folder.Items.Count 'This loops through the inbox items.
        If VBA.DateValue(VBA.Now) - 1 <= VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) And VBA.DateValue(VBA.Now) > VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) Then 'This is checking that the emails were received within a certain time frame.
            For i = 0 To UBound(emails) 
                If StrComp(Folder.Items.Item(iRow).SenderEmailAddress, emails(i)) = 0 Then 'This is checking that the emails are coming from specific address', emails is an array of accepted address'.
                    For Each cel In rRng.Cells 'The beggining of my for each
                        If InStr(1, Folder.Items.Item(iRow).Subject, cel.Text) > 0 Then 'checking to see if my the content from one of the cells in the range is part of the subject from the emails.
                             ThisWorkbook.Sheets(1).Cells(oRow, 3) = cel.Value 'If it is part of the subject, take the value from the cell in the range where it matches, and put that value in another cell.
                        End If
                    Next cel
                    oRow = oRow + 1
                    ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
                    ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).ReceivedTime
                    ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress
                    ThisWorkbook.Sheets(1).Cells(oRow, 6) = Folder.Items.Item(iRow).Subject
                    ThisWorkbook.Sheets(1).Cells(oRow, 7) = Folder.Items.Item(iRow).Body
                    'All of this above code is inserting data from the emails into cells.
                End If
            Next i
        End If
    Next iRow

oRow is a counter for rows in the excel sheet.

iRow is a counter for the email items.

Is there an even better approach?

Upvotes: 0

Views: 187

Answers (1)

Tim Williams
Tim Williams

Reputation: 166685

EDIT2: still guessing a bit...

Dim itm As Object '<<< this makes your code more readable...
Dim rw as range

Set rw = ThisWorkbook.Sheets(1).Rows(1)

For iRow = 1 To Folder.Items.Count

    Set itm = Folder.Items.Item(iRow)

    If Now - 1 <= itm.ReceivedTime Then
        For i = 0 To UBound(emails)
            If StrComp(itm.SenderEmailAddress, emails(i)) = 0 Then

                For Each cel In rRng.Cells
                    If InStr(1, itm.Subject, cel.Text) > 0 Then
                        rw.Cells(3).Value = cel.Value  
                        Exit For 'exit loop over cells
                    End If 'subject match
                Next cel
                'record the other details
                rw.Cells(1).Value = itm.ReceivedTime
                rw.Cells(5).Value = itm.SenderEmailAddress
                rw.Cells(6).Value = itm.Subject
                rw.Cells(7).Value = itm.Body
                Set rw = rw.Offset(1, 0)
                Exit For 'exit loop over emails
           End If 'email match
        Next i
    End If
Next iRow

Upvotes: 1

Related Questions