Help with two columns

Hi there, I need some help with a piece of code that I'm working on. I have two columns Column B is the Status column and Column D is the Exp. Date column. What I'm trying to do is to look at each cell in column D and if the date that is there is < Date, I next want it to look at the corresponding cell in column B and if the value = "Active" I want Active to be changed to "Expired". I have been able to get the code to work for one row but cannot get it to work for an entire column. I would also like it to stop if the cell in column D is empty (means that it has reached the end of the list). The code that I have been trying is:

Private Sub CommandButton2_Click()

Dim StatRng As Range
Dim myRng As Range
Dim D As Range 'Column D
Dim B As Range 'Column B

Set myRng = Range("ExpirationDate")
Set StatRng = Range("Status")
For Each D In myRng
For Each B In StatRng

If D.Value < Date And B.Value = "Active" Then
B.Value = "Expired"
B.Font.ColorIndex = 0
B.Interior.ColorIndex = 45
End If


Next B

Next D


End Sub

The problem that I'm having with this code is that when it hits Next B it stops there never going to Next D. The cells in column B move but the cells in column D don't.

Any help would be greatly appreciated.

I modified your code to loop only on column D (ExpirationDate) and used the OFFSET method to determine the values in column B. I also put in a test to stop the loop if the cell in column D is blank (see the BOLD code). Try this instead:

Private Sub CommandButton2_Click()
Dim StatRng As Range
Dim myRng As Range
Dim D As Range 'Column D
Set myRng = Range("ExpirationDate")
For Each D In myRng
    If D.Value < Date And D.Offset(0, -2).Value = "Active" Then
        D.Offset(0, -2).Value = "Expired"
        D.Offset(0, -2).Font.ColorIndex = 0
        D.Offset(0, -2).Interior.ColorIndex = 45
    End If
    If D.Value = "" Then Exit For
Next D
End Sub

Hope this helps,
theDude

Thank you very much. Works great.