Replace a string in Column C based on matching ind

Question

Using the following code (source) I have been able to perform the following:

1. Check if a string in Sheet1!A is in Sheet2!A.
2. If found, compare Column C values.
   • If Column C values are different, set value of Sheet2 to that in Sheet1 and highlight light green.
   • Else, exit.
3. If not found, copy whole row to Sheet2 and highlight dark green.

I would additionally like to perform additional steps which I'm having trouble implementing.

If string in Sheet2!A does not exist in Sheet1!A then highlight red.

Code here:

Sub LoopMatchReplace()

Dim ShSrc As Worksheet, ShTar As Worksheet
Dim SrcLRow As Long, TarLRow As Long, NextEmptyRow As Long
Dim RefList As Range, TarList As Range, RefCell As Range, RefColC
Dim TarCell As Range, TarColC As Range
Dim IsFound As Boolean
Dim ToFind As String

With ThisWorkbook
    Set ShSrc = .Sheets("Sheet1")
    Set ShTar = .Sheets("Sheet2")
End With

'Get the last rows for each sheet.
SrcLRow = ShSrc.Range("A" & Rows.Count).End(xlUp).Row
TarLRow = ShTar.Range("A" & Rows.Count).End(xlUp).Row

'Set the lists to compare.
Set RefList = ShSrc.Range("A2:A" & SrcLRow)
Set TarList = ShTar.Range("A2:A" & TarLRow)

'Initialize boolean, just for kicks.
IsFound = False

'Speed up the process.
Application.ScreenUpdating = False

'Create the loop.
For Each RefCell In RefList

    ToFind = RefCell.Value

    'Look for the value in our target column.
    On Error Resume Next
    Set TarCell = TarList.Find(ToFind)
    If Not TarCell Is Nothing Then IsFound = True
    On Error GoTo 0

    'If value exists in target column...
    If IsFound Then
        'Compare the Column C of both sheets.
        Set TarColC = TarCell.Offset(0, 2)
        Set RefColC = RefCell.Offset(0, 2)
        'If they are different, set the value to match and highlight.
        If TarColC.Value <> RefColC.Value Then
            TarColC.Value = RefColC.Value
            TarColC.Interior.ColorIndex = 4
        End If
    Else 'If value does not exist...
        'Get next empty row, copy the whole row from source sheet, and highlight.
        NextEmptyRow = ShTar.Range("A" & Rows.Count).End(xlUp).Row + 1
        RefCell.EntireRow.Copy ShTar.Rows(NextEmptyRow)
        ShTar.Rows(NextEmptyRow).SpecialCells(xlCellTypeConstants).Interior.ColorIndex = 3
    End If

    'Set boolean check to False.
    IsFound = False

Next RefCell

Application.ScreenUpdating = True

End Sub

Answer 1

EDIT:

Try this code. A reversal has been added in the end. Did not put in explanations since it's just similar to the previous codeblock.

Sub LoopMatchReplace()

    Dim ShSrc As Worksheet, ShTar As Worksheet
    Dim SrcLRow As Long, TarLRow As Long, NextEmptyRow As Long
    Dim RefList As Range, TarList As Range, RefCell As Range, RefColC As Range
    Dim TarCell As Range, TarColC As Range
    Dim IsFound As Boolean, IsFoundReverse As Boolean
    Dim ToFind As String, ToFindReverse As String
    Dim TarListReverse As Range, TarCellReverse As Range
    Dim RefListReverse As Range, RefCellReverse As Range

    With ThisWorkbook
        Set ShSrc = .Sheets("Sheet1")
        Set ShTar = .Sheets("Sheet2")
    End With

    'Get the last rows for each sheet.
    SrcLRow = ShSrc.Range("A" & Rows.Count).End(xlUp).Row
    TarLRow = ShTar.Range("A" & Rows.Count).End(xlUp).Row

    'Set the lists to compare.
    Set RefList = ShSrc.Range("A2:A" & SrcLRow)
    Set TarList = ShTar.Range("A2:A" & TarLRow)

    'Initialize boolean, just for kicks.
    IsFound = False

    'Speed up the process.
    Application.ScreenUpdating = False

    'Create the loop.
    For Each RefCell In RefList

        ToFind = RefCell.Value

        'Look for the value in our target column.
        On Error Resume Next
        Set TarCell = TarList.Find(ToFind)
        If Not TarCell Is Nothing Then IsFound = True
        On Error GoTo 0

        'If value exists in target column...
        If IsFound Then
            'Compare the Column C of both sheets.
            Set TarColC = TarCell.Offset(0, 2)
            Set RefColC = RefCell.Offset(0, 2)
            'If they are different, set the value to match and highlight.
            If TarColC.Value <> RefColC.Value Then
                TarColC.Value = RefColC.Value
                TarColC.Interior.ColorIndex = 4
            End If
        Else 'If value does not exist...
            'Get next empty row, copy the whole row from source sheet, and highlight.
            NextEmptyRow = ShTar.Range("A" & Rows.Count).End(xlUp).Row + 1
            RefCell.EntireRow.Copy ShTar.Rows(NextEmptyRow)
            ShTar.Rows(NextEmptyRow).SpecialCells(xlCellTypeConstants).Interior.ColorIndex = 3
        End If

        'Set boolean check to False.
        IsFound = False

    Next RefCell

    'Reverse checking of names.
    IsFoundReverse = False
    SrcLRow = ShSrc.Range("A" & Rows.Count).End(xlUp).Row
    TarLRow = ShTar.Range("A" & Rows.Count).End(xlUp).Row
    Set TarListReverse = ShTar.Range("A2:A" & TarLRow)
    Set RefListReverse = ShSrc.Range("A2:A" & SrcLRow)

    For Each TarCellReverse In TarListReverse

        ToFindReverse = TarCellReverse.Value
        On Error Resume Next
        Set RefCellReverse = RefListReverse.Find(ToFindReverse)
        If Not RefCellReverse Is Nothing Then IsFoundReverse = True
        On Error GoTo 0

        If IsFoundReverse Then
            'Do nothing and move on.
        Else
            TarCellReverse.EntireRow.SpecialCells(xlCellTypeConstants).Interior.ColorIndex = 3
        End If

        IsFoundReverse = False

    Next TarCellReverse

    Application.ScreenUpdating = True

End Sub

Video demo can be found here.

Let us know if this helps.