[Solved] Using If statements to evaluate cells and then change color similar to conditional formatting

[bino1121]

So the goal here Is that I have a sheet ranging from A:J with headers on row 1. I am trying to evaluate columns F & G (variable ranges) They are date ranges but I would like this to apply for all values not just dates. The if conditions I am testing for include

This should be accounted for that F2 & G2 are compared then it goes to F3 & G3... and so on through a variable range (Last row)
If F is >= G the the boxes should turn green
If F is < G then the boxes should turn yellow

below is the code I have got so far it runs with no errors but nothing happens when I run it.

Sub ColorEvaluation()

Dim Ws1 as Worksheet
Dim lr as Long
DIm r as Long

Set Ws1 = thisworkbook.Worksheets("Sheet 1")

lr = Ws1.Cells(Ws1.Rows.Count, "A").End(xlUp).Row

for r = 2 to lr

if Ws1.Range("F" & lr) >= Ws1.Range("G" & lr) _
then
Ws1.Range("F" & lr).interior.colorindex = 4
Ws1.Range("G" & lr).interior.colorindex = 4

Elseif Ws1.Range("F" & lr) < Ws1.Range("G" & lr) _
then
Ws1.Range("F" & lr).interior.colorindex = 6
Ws1.Range("G" & lr).interior.colorindex = 6

End if

Next r

End Sub

 

[Lutfor Rahman Shimanto]

So the goal here Is that I have a sheet ranging from A:J with headers on row 1. I am trying to evaluate columns F & G (variable ranges) They are date ranges but I would like this to apply for all values not just dates. The if conditions I am testing for include

This should be accounted for that F2 & G2 are compared then it goes to F3 & G3... and so on through a variable range (Last row)
If F is >= G the the boxes should turn green
If F is < G then the boxes should turn yellow

below is the code I have got so far it runs with no errors but nothing happens when I run it.

Sub ColorEvaluation()

Dim Ws1 as Worksheet
Dim lr as Long
DIm r as Long

Set Ws1 = thisworkbook.Worksheets("Sheet 1")

lr = Ws1.Cells(Ws1.Rows.Count, "A").End(xlUp).Row

for r = 2 to lr

if Ws1.Range("F" & lr) >= Ws1.Range("G" & lr) _
then
Ws1.Range("F" & lr).interior.colorindex = 4
Ws1.Range("G" & lr).interior.colorindex = 4

Elseif Ws1.Range("F" & lr) < Ws1.Range("G" & lr) _
then
Ws1.Range("F" & lr).interior.colorindex = 6
Ws1.Range("G" & lr).interior.colorindex = 6

End if

Next r

End Sub

Hello Bino1121

It is good to see you again at the ExcelDemy Forum. Thanks for sharing your problem with such clarity.

I am delighted to inform you that I have developed an Excel Event Procedure and a Sub-procedure to fulfil your requirements. I modified some of your given sub-procedure and created an event procedure to bring a dynamic vibe.

Excel VBA Event Procedure:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim AffectedRange As Range
    Dim Cell As Range

    Set AffectedRange = Intersect(Target, Me.Range("F:G"))

    If Not AffectedRange Is Nothing Then
        Call Module1.ColorEvaluation
    End If

End Sub

Excel VBA Sub-procedure:

Sub ColorEvaluation()

    Dim Ws1 As Worksheet
    Dim lr As Long
    Dim r As Long

    Set Ws1 = ThisWorkbook.Worksheets("Sheet1")

    lr = Ws1.Cells(Ws1.Rows.Count, "A").End(xlUp).Row

    For r = 2 To lr
        If Ws1.Range("F" & r).Value >= Ws1.Range("G" & r).Value Then
            Ws1.Range("F" & r).Interior.ColorIndex = 4
            Ws1.Range("G" & r).Interior.ColorIndex = 4
        Else
            Ws1.Range("F" & r).Interior.ColorIndex = 6
            Ws1.Range("G" & r).Interior.ColorIndex = 6
        End If
    Next r

End Sub

OUTPUT OVERVIEW:

​

I am also attaching the solution workbook to help you understand better. I hope these procedures will fulfil your requirements. Good luck!

Regards
Lutfor Rahman Shimanto
ExcelDemy