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

[TrainTrainer]

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

sample.JPG

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.

[Paul_Hossler]

Easiest way

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