I am completely new to VBA and what I am trying to do is to color the cell when condition is met and valid value for package of a product is found in another column in a different sheet.

I have been trying to write something that does it, but it doesn't work. There is a problem with the if statement, but I cannot find where.

Sub validation()

Dim lastRow_s As Long
Dim lastRow_m As Long

lastRow_s = Sheets("product").Cells(Rows.Count, "D").End(xlUp).Row
lastRow_m = Sheets("product").Cells(Rows.Count, "H").End(xlUp).Row

    For i = 2 To lastRow_s
        For j = 2 To lastRow_m
            If Sheets("product").Cells(i,"D").Value = 
                Sheets("valid_package").Cells(j,"A").Value And
                Sheets("product").Cells(i, "H").Value =
                Sheets("valid_package").Cells(j,"B").Value Then
                Sheets("product").Cells(i, "H").Value = vbGreen
            End If
        Next j
    Next i


End Sub

I cannot find what I am doing wrong here.

So what I am trying to do is to iterate over two columns to make sure that the product in column D has a valid package in column H in the product sheet. In the valid_package sheet there is a column for product and package that are valid for this products, so valid_package looks like this:

The product sheet is like this if you take only the two columns:

What I want is to highlight correct package in column H for sheet product or incorrect package in column H for sheet product, it doesn't matter what is colored.

Now what I am getting is. Expected: "line number or label or statement or end of statement.

CodePudding user response：

Color Conditionally Matching Cells

Option Explicit

Sub TestAll()
    ValidationQuickFix
    ValidationReadable
    ValidationEfficient
' Result on 1000 matches in 10000 rows of destination 
' with only 10 rows of unique source values:
' Quick Fix: 6,1875
' Readable:  2,21484375
' Efficient: 0,87890625
End Sub

Sub ValidationQuickFix()
    Dim t As Double: t = Timer
    
    ThisWorkbook.Activate
    
    Dim lastRow_s As Long
    lastRow_s = Worksheets("valid_package").Cells(Rows.Count, "A").End(xlUp).Row
    Dim lastRow_d As Long
    lastRow_d = Worksheets("product").Cells(Rows.Count, "D").End(xlUp).Row

    Dim i As Long, j As Long

    For i = 2 To lastRow_d
        For j = 2 To lastRow_s
            If Worksheets("product").Cells(i, "D").Value = _
                    Worksheets("valid_package").Cells(j, "A").Value Then
                If Worksheets("product").Cells(i, "H").Value = _
                        Worksheets("valid_package").Cells(j, "B").Value Then
                    Worksheets("product").Cells(i, "H").Interior.Color = vbGreen
                Else
                    Worksheets("product").Cells(i, "H").Interior.Color = xlNone
                End If
            End If
        Next j
    Next i

    Debug.Print "Quick Fix: " & Timer - t
End Sub

Sub ValidationReadable()
    Dim t As Double: t = Timer
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("valid_package")
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("product")
    Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, "D").End(xlUp).Row

    Dim i As Long, j As Long
    
    For i = 2 To dlRow
        For j = 2 To slRow
            If dws.Cells(i, "D").Value = sws.Cells(j, "A").Value Then
                If dws.Cells(i, "H").Value = sws.Cells(j, "B").Value Then
                    dws.Cells(i, "H").Interior.Color = vbGreen
                Else
                    dws.Cells(i, "H").Interior.Color = xlNone
                End If
            End If
        Next j
    Next i

    Debug.Print "Readable:  " & Timer - t
End Sub

Sub ValidationEfficient()
    Dim t As Double: t = Timer
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("valid_package")
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
    Dim srg1 As Range: Set srg1 = sws.Range("A2:A" & slRow)
    Dim srg2 As Range: Set srg2 = sws.Range("B2:B" & slRow)
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("product")
    Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, "D").End(xlUp).Row
    Dim drg1 As Range: Set drg1 = dws.Range("D2:D" & dlRow)
    Dim drg2 As Range: Set drg2 = dws.Range("H2:H" & dlRow)

    Dim ddrg As Range
    Dim dCell As Range
    Dim sIndex As Variant
    Dim dr As Long
    
    For dr = 1 To drg1.Rows.Count
        sIndex = Application.Match(drg1.Cells(dr).Value, srg1, 0)
        If IsNumeric(sIndex) Then
            If drg2.Cells(dr).Value = srg2.Cells(sIndex).Value Then
                If ddrg Is Nothing Then
                    Set ddrg = drg2.Cells(dr)
                Else
                    Set ddrg = Union(ddrg, drg2.Cells(dr))
                End If
            End If
        End If
    Next dr

    If Not ddrg Is Nothing Then
        drg2.Interior.Color = xlNone
        ddrg.Interior.Color = vbGreen
    End If

    Debug.Print "Efficient: " & Timer - t
End Sub

CodePudding user response：

Please, test the next code. It should be fast, using Find, placing the range to be colored in a Union range and coloring it at the code end. I hope that I correctly understood what you want and mostly what you have...

Sub validation()
Dim shP As Worksheet, shVP As Worksheet, rngColor As Range, rngA As Range, rngB As Range
Dim lastRow_P As Long, lastRow_VP As Long, cellMatch As Range, i As Long

Set shP = Sheets("product")
Set shVP = Sheets("valid_package")
lastRow_P = shP.cells(rows.Count, "D").End(xlUp).row
lastRow_VP = shVP.cells(rows.Count, "A").End(xlUp).row


Set rngA = shVP.Range("A2:A" & lastRow_VP)
For i = 2 To lastRow_P
    Set cellMatch = rngA.Find(what:=shP.cells(i, "D").Value, LookIn:=xlValues, Lookat:=xlWhole)
    If Not cellMatch Is Nothing Then
        If cellMatch.Offset(0, 1).Value = shP.cells(i, "H").Value Then
            If rngColor Is Nothing Then
                Set rngColor = shP.cells(i, "H")
            Else
                Set rngColor = Union(rngColor, shP.cells(i, "H"))
            End If
        End If
    End If
Next i

If Not rngColor Is Nothing Then rngColor.Interior.color = vbGreen
End Sub