VBA to compare values in 2 cells and post a value in another

I'm currently doing this with formulas and would like to automate it with VBA

Attachment 25992

This is my format. Agent decision is what they assigned to the job, correct decision is what they should have assigned.

agent tagged a color but it wasn't correct - overtag
agent didn't tag a color but should have - undertag

For each tag I need to determine if the agent overtagged or undertagged that color, and put a number in that column. Then I need it to loop through all rows to the last.

I've googled this but not finding what i need.

Easiest way

Code:

---

Option Explicit


Sub OverUnder()
    Dim R As Long, B As Long, G As Long, O As Long
    Dim i As Long
    Dim s As String
   
    With ActiveSheet.Cells(1, 1).CurrentRegion
        For i = 3 To .Rows.Count
           
            R = 0
            B = 0
            G = 0
            O = 0
           
            s = LCase(.Cells(i, 1).Value)
            If InStr(s, "red") > 0 Then R = R + 1
            If InStr(s, "blue") > 0 Then B = B + 1
            If InStr(s, "green") > 0 Then G = G + 1
            If InStr(s, "orange") > 0 Then O = O + 1
       
            s = LCase(.Cells(i, 2).Value)
            If InStr(s, "red") > 0 Then R = R - 1
            If InStr(s, "blue") > 0 Then B = B - 1
            If InStr(s, "green") > 0 Then G = G - 1
            If InStr(s, "orange") > 0 Then O = O - 1
   
            .Cells(i, 3).Resize(1, 8).Value = 0
   
            If R > 0 Then
                .Cells(i, 3) = R
            ElseIf R < 0 Then
                .Cells(i, 4) = -R
            End If
   
            If G > 0 Then
                .Cells(i, 5) = G
            ElseIf G < 0 Then
                .Cells(i, 6) = -G
            End If
           
            If B > 0 Then
                .Cells(i, 7) = B
            ElseIf B < 0 Then
                .Cells(i, 8) = -B
            End If
           
            If O > 0 Then
                .Cells(i, 9) = O
            ElseIf O < 0 Then
                .Cells(i, 10) = -O
            End If
        Next i
    End With


End Sub

---