Update a Cell Value to Accept or Reject based on Other Cells Colors (All in the Same Row)

[MaggieSlate]

Hi,

I am trying to update a cell (LR, 3) with Accept or Reject based on the colors from cell range (LR, 4) to (LR, 8). I am having trouble specifically this line, If Rng.Interior.ColorIndex = 3 Then.

What I would like to have happen is that is any of the cells are shaded red from being outside of a range, it would reject the part.

Thanks, Maggie

Here is the code...

Private Sub CmdButton_Submit_Click()
'finds first empty row to input data
LR = Sheets("Inspection DB").Range("A1000000").End(xlUp).Row + 1

'Saving the from the userform to an excel sheet
Worksheets("Inspection DB").Cells(LR, 1) = ComboBox_Number.Value
Worksheets("Inspection DB").Cells(LR, 2) = ID_Number_Textbox.Value
Worksheets("Inspection DB").Cells(LR, 4) = A1_TextBox.Value
If Worksheets("Inspection DB").Cells(LR, 4).Value <= 55 And Worksheets("Inspection DB").Cells(LR, 4).Value >= 2 Then
'do nothing
Else
Worksheets("Inspection DB").Cells(LR, 4).Interior.ColorIndex = 3
End If
Worksheets("Inspection DB").Cells(LR, 5) = A2_TextBox.Value
If Worksheets("Inspection DB").Cells(LR, 5).Value <= 5 And Worksheets("Inspection DB").Cells(LR, 4).Value >= 2 Then
'do nothing
Else
Worksheets("Inspection DB").Cells(LR, 5).Interior.ColorIndex = 3
End If
Worksheets("Inspection DB").Cells(LR, 6) = A3_TextBox.Value
If Worksheets("Inspection DB").Cells(LR, 6).Value <= 5 And Worksheets("Inspection DB").Cells(LR, 4).Value >= 2 Then
'do nothing
Else
Worksheets("Inspection DB").Cells(LR, 6).Interior.ColorIndex = 3
End If
Worksheets("Inspection DB").Cells(LR, 7) = A4_TextBox.Value
If Worksheets("Inspection DB").Cells(LR, 7).Value <= 5 And Worksheets("Inspection DB").Cells(LR, 4).Value >= 2 Then
'do nothing
Else
Worksheets("Inspection DB").Cells(LR, 7).Interior.ColorIndex = 3
End If
Worksheets("Inspection DB").Cells(LR, 8) = A5_TextBox.Value
If Worksheets("Inspection DB").Cells(LR, 8).Value <= 72 And Worksheets("Inspection DB").Cells(LR, 4).Value >= 37 Then
'do nothing
Else
Worksheets("Inspection DB").Cells(LR, 8).Interior.ColorIndex = 3
End If
For Each cell In Range(Cells(LR, 4), Cells(LR, 8))

'If Rng.Interior.ColorIndex = 3 Then
Worksheets("Inspection DB").Cells(LR, 3).Value = "Reject"
Else
Worksheets("Inspection DB").Cells(LR, 3).Value = "Accept"
End If
Next
Worksheets("Inspection DB").Cells(LR, 9) = R_Number_Textbox.Value
Worksheets("Inspection DB").Cells(LR, 10) = Op_Name_TextBox.Value
Worksheets("Inspection DB").Cells(LR, 11) = Date

'gives confirmation that the data was saved
MsgBox ("Data Saved")
cleardata
End Sub
<strike></strike>

 

[Fluff]

Try

If cell.Interior.ColorIndex = 3 Then