CODEWITHSUNDEEP
excelvba
Hani
Hani

Reputation: 23

Fill in Color by Compare Two Different keywords

I want to fill in color entire row by compare two column with different cell text. As shown in image below, If I enter input at column1 "PAID" and at column2 "DONE". I want entire row fill in green colour.

enter image description here

My code is:

Dim itm As Range
Dim rw As Long
With Sheets("PO 2019_Vendor")
rw = .Range("A" & .Rows.Count).End(xlUp).Row

If .Range("AG" & rw).Value = "PAID" And .Range("AJ" & rw).Value = "DONE" Then itm.EntireRow.Interior.Color = 4

If .Range("AG" & rw).Value = "PAID" And .Range("AJ" & rw).Value = "NOTRCV" Then itm.EntireRow.Interior.Color = 6

If .Range("AG" & rw).Value = "PENDING" And .Range("AJ" & rw).Value = "DONE" Then itm.EntireRow.Interior.Color = 28

End With
End Sub

I hope you understand my explanation and will help me out. Thank you in advance.

Upvotes: 2

Views: 65

Answers (2)

JvdV
JvdV

Reputation: 76000

Two things I would suggest:

  • Loop through an Array: As I don't know the amount of rows your would want to loop through, arrays should be significantly faster.
  • Don't use the Color property when using color indexes. You either want to use Color or ColorIndex. The former takes a Long value representing a RGB color (or the RGB(...,...,...) syntax itself. The latter takes a color index from within your currently selected color theme. Mixing Color property with an index number will paint the row black. I assume this is what you try to do.
Sub ColorRows()

Dim arr As Variant
Dim rw As Long, x As Long

With Sheet1 'Change according to your sheet's CodeName (see Project Explorer)
    rw = .Cells(.Rows.Count, "AG").End(xlUp).Row
    arr = .Range("AG1:AJ" & rw)
    For x = LBound(arr) To UBound(arr)
        If arr(x, 1) = "PAID" And arr(x, 4) = "DONE" Then .Rows(x).Interior.ColorIndex = 4
        If arr(x, 1) = "PAID" And arr(x, 4) = "NOTRCV" Then .Rows(x).Interior.ColorIndex = 6
        If arr(x, 1) = "PENDING" And arr(x, 4) = "DONE" Then .Rows(x).Interior.ColorIndex = 28
    Next x
End With

End Sub

Upvotes: 1

Teamothy
Teamothy

Reputation: 2016

If that columns are AG and AJ, and headers are in first row:

Sub erf()
Dim itm As Range
Dim rw As Long

    With Sheets("PO 2019_Vendor")

        rw = .Range("AG" & .Rows.Count).End(xlUp).Row

        For i = 2 To rw 'only if your headers are in 1 row

        If .Range("AG" & i).Value = "PAID" And .Range("AJ" & i).Value = "DONE" Then Rows(i).Interior.Color = 4

        If .Range("AG" & i).Value = "PAID" And .Range("AJ" & i).Value = "NOTRCV" Then Rows(i).EntireRow.Interior.Color = 6

        If .Range("AG" & i).Value = "PENDING" And .Range("AJ" & i).Value = "DONE" Then Rows(i).EntireRow.Interior.Color = 28

        Next

    End With

End Sub

Upvotes: 1

Related Questions