Change conditional formatting to VBA for efficiency

[kvar]

I have conditional formatting set up now but it is much to slow, I need something more efficient.
Here is the formula I have: =OR(AND(F4="", $E4="Finished Good"), AND(F4="",$E4="Device Identifier"))
This is applied to D4:CG2700
I need a sub in VBA to loop through the rows and if column E equals either finished good or device identifier AND the cell in question is blank, turn the background yellow.
Is there a simple solution? I think I'm over complicating as I can't get it to work.

 

[DanteAmor]

Try with this macro:

Sub loop_rows()
    Dim i As Long
    For i = 4 To Range("E" & Rows.Count).End(xlUp).Row
        If (Cells(i, "E").Value = "Finished Good" And Cells(i, "F").Value = "") Or _
           (Cells(i, "E").Value = "Device Identifier" And Cells(i, "F").Value = "") Then
           Range(Cells(i, "D"), Cells(i, "CG")).Interior.ColorIndex = 6
        End If
    Next
    MsgBox "End"
End Sub

 

[Mentor82]

I have conditional formatting set up now but it is much to slow, I need something more efficient.
Here is the formula I have: =OR(AND(F4="", $E4="Finished Good"), AND(F4="",$E4="Device Identifier"))
This is applied to D4:CG2700
I need a sub in VBA to loop through the rows and if column E equals either finished good or device identifier AND the cell in question is blank, turn the background yellow.
Is there a simple solution? I think I'm over complicating as I can't get it to work.

Hi,
Try this code.

Sub colourcells()
Dim rng as range
Dim c as range

Set rng = range("D4:CG2700")
For each c in rng
    If c.offset(0,2)="" and (range("e" & c.row)="Finished Good" or range("e" & c.row)="Device Identifier") then
        C.intrerior.color=vbYellow
    End if
Next c

Set rng = nothing

End sub

 

[Mentor82]

Hi again
Jusy a little correction. Just forgot to remove formatting if conditions are nor met.

Sub colourcells()
Dim rng as range
Dim c as range

Set rng = range("D4:CG2700")
For each c in rng
    If c.offset(0,2)="" and (range("e" & c.row)="Finished Good" or range("e" & c.row)="Device Identifier") then
        c.intrerior.color=vbYellow
    Else
        c.interior.color=xlnone
    End if
Next c

Set rng = nothing

End sub

 

[DanteAmor]

Just forgot to remove formatting if conditions are nor met.

You're right

Kvar Try with this:

Sub loop_rows()
    Dim i As Long, u As Long
    u = Range("E" & Rows.Count).End(xlUp).Row
    Range(Cells(4, "D"), Cells(u, "CG")).Interior.ColorIndex = xlNone
    For i = 4 To u
        If (Cells(i, "E").Value = "Finished Good" And Cells(i, "F").Value = "") Or _
           (Cells(i, "E").Value = "Device Identifier" And Cells(i, "F").Value = "") Then
           Range(Cells(i, "D"), Cells(i, "CG")).Interior.ColorIndex = 6
        End If
    Next
    MsgBox "End"
End Sub

 

[kvar]

Thank you so much! This is definitely getting me on the right track.
It doesn't take the yellow away when text is added to a cell though. I think it needs to run every time a change is made?
Basically if that field (F) contains either of those values then the rest of the cells need to be filled out. So the highlighting is to let the user know something is missing. Once they fill in that field the formatting should disappear, and if they delete the data it should be highlighted again.

 

[Norie]

Are you sure it's the conditional formatting that's slowing things down?

The formula you are using looks pretty straightforward.

 

[kvar]

Are you sure it's the conditional formatting that's slowing things down?

The formula you are using looks pretty straightforward.

Before I added it the file opened and closed like normal, I haven't done anything else to it. There are some drop-downs in it but no formulas or anything else intensive. So I guess I just assumed the conditional formatting was the problem since that's when the problem started.

 

[DanteAmor]

To work in automatic, put the following code in the events of your sheet

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E:F")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        If Target.Row < 4 Then Exit Sub
        Dim i As Long
        i = Target.Row
        Range(Cells(i, "D"), Cells(i, "CG")).Interior.ColorIndex = xlNone
        If (Cells(i, "E").Value = "Finished Good" And Cells(i, "F").Value = "") Or _
           (Cells(i, "E").Value = "Device Identifier" And Cells(i, "F").Value = "") Then
               Range(Cells(i, "D"), Cells(i, "CG")).Interior.ColorIndex = 6
        End If
    End If
End Sub