VBA macro to find one column value to other column in different sheet

Question

I need a formula that will match patient name from sheet 2 in sheet 1, then see if column H in that row has 'Yes' written in it and if so, change color of that row in sheet 2 to red.

I have written this formula -

Dim patient1 As String
Dim patient2 As String
Dim answer As String
Dim c As Range
Dim counter As Long
Dim total As Long
counter = 1
total = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To total
answer = Worksheets("hedis1").Range("h" & counter).Value
patient1 = Worksheets("hedis1").Range("d" & counter).Value
patient2 = Worksheets("hedis2").Range("d" & counter).Value
k = "a" & counter
If patient1 = patient2 Then
   If answer = "Yes" Then
        For Each c In Worksheets("hedis2").Range(k)

            c.EntireRow.Interior.Color = 255 ' Change the number to match the desired color.

        Next c
   End If
End If
counter = counter + 1
Next i

I want to check all values of column D of spreadsheet1 to column D of spreadsheet2. My formula checks only for same rows. Hope you understand what I am trying to say. Thanks

Answer 1

Something like this might work for you, not sure I'm 100% on what you want.

Sub thisone()
Dim patient1 As String
Dim patient2 As String
Dim answer As String
Dim c As Range
Dim counter As Long
Dim total As Long
Dim totalInner As Long
counter = 1
total = Range("A" & Rows.Count).End(xlUp).Row
totalInner = Worksheets("hedis2").Range("d" & Rows.Count).End(xlUp).Row
For i = 1 To total
answer = Worksheets("hedis1").Range("h" & counter).Value
patient1 = Worksheets("hedis1").Range("d" & counter).Value
k = "a" & counter
For j = 1 To totalInner
    patient2 = Worksheets("hedis2").Range("d" & j).Value

    If patient1 = patient2 Then
        If answer = "Yes" Then
            For Each c In Worksheets("hedis2").Range(k)

                c.EntireRow.Interior.Color = 255 ' Change the number to match the desired color.

            Next c
        End If
    End If
    Next j
counter = counter + 1
Next i
End Sub

Answer 2

Use the Worksheet match function, its very fast...

Dim patient1 As String
Dim answer As String
Dim total As Long
Dim iRowMatched As Long

total = Range("A" & Rows.Count).End(xlUp).Row

On Error Resume Next
For i = 1 To total
    answer = Worksheets("hedis1").Range("h" & counter).Value
    patient1 = Worksheets("hedis1").Range("d" & counter).Value

    iRowMatched = WorkSheetFunction.Match(patient1,Worksheets("hedis1").Range("$D:$D"),0)
    If Err.Number = 0 Then
           If answer = "Yes" Then
                Worksheets("hedis2").Rows(iRowMatched).Interior.Color = vbRed '
           End If
    Else
       Err.Clear
    End If
Next i
On Error Goto 0