Compare column A with column C, Move matching Cell from location to column B on corresponding row

Question

Sub Match()
Dim var As Variant, iSheet As Integer, iRow As Long, iRowL As Long, bln As Boolean, rng1 As Range, rng2 As Range, i As Long, j As Long

  If Not IsEmpty(rng1) Then
     For i = 1 To Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
     Set rng1 = Sheets("Sheet1").Range("A" & i)
     
     For j = 1 To Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row
        Set rng2 = Sheets("Sheet1").Range("C" & j)
        
        bln = False
        var = Application.Match(rng1.Value, rng2, 0)
        

        If Not IsError(var) Then
           bln = True
           Exit For
           Exit For
       End If
        Set rng2 = Nothing
    Next j
    Set rng1 = Nothing
Next i
    
For i = 1 To Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
     Set rng1 = Sheets("Sheet1").Range("A" & i)
     

  If bln = False Then
     Cells(rng1).Font.Bold = False
     Else
     Cells(rng1).Font.Bold = True
  End If
   Next i
   End If
Application.ScreenUpdating = True
End Sub

Sub CompareAndHighlight()

    Dim rng1 As Range, rng2 As Range, i As Long, j As Long
    For i = 1 To Sheets("sheet1").Range("C" & Rows.Count).End(xlUp).Row
        Set rng1 = Sheets("sheet1").Range("C" & i)
        For j = 1 To Sheets("sheet2").Range("C" & Rows.Count).End(xlUp).Row
            Set rng2 = Sheets("sheet2").Range("C" & j)
            If StrComp(Trim(rng1.Text), Trim(rng2.Text), vbTextCompare) = 0 Then
                rng1.Interior.Color = RGB(255, 255, 0)
            End If
            Set rng2 = Nothing
        Next j
        Set rng1 = Nothing
    Next i

End Sub

I am trying to compare the data column A with the data in column C

However the challenge is , If there is a match I will then need to move the cell from column C to column B on the corresponding row.

Unfortunately I can not post pictures yet, I hope this is clear enough for someone to support me with?

I have improvised to use the "code snippet to display how the data should look assuming they are arranged in Columns A B and C

Before 

A12334		A12352
A12335		A12353
A12336		A12339
A12337		A12340
A12338		A12341
A12339		A12354
A12340		A12355
A12341		A12356
A12342		A22354
A12343		A22356
A12344		A22358
A12345		A22360
A12346		A22362
A12347		A22364
A12348		A22366
A12349		A22368
A12350		A22370
A12351		A22372
A12352		A12357
A12353		A12358
A12354		A12334
A12355		A12335
A12356		A12336
A12357		A12337
A12358		A12338
A12359		A22370
A12360		A22372
A12361		A12361

After:

A12334	A12334	
A12335	A12335	
A12336	A12336	
A12337	A12337	
A12338	A12338	
A12339	A12339	
A12340	A12340	
A12341	A12341	
A12342		A22354
A12343		A22356
A12344		A22358
A12345		A22360
A12346		A22362
A12347		A22364
A12348		A22366
A12349		A22368
A12350		A22370
A12351		A22372
A12352	A12352	
A12353	A12353	
A12354	A12354	
A12355	A12355	
A12356	A12356	
A12357	A12357	
A12358	A12358	
A12359		A22370
A12360		A22372
A12361		A12361

Answer 1

Sub CompareAndMove()

Dim rng1 As Range, rng2 As Range, i As Long, iL As Long, var As Range, j As Long, ws1 As Worksheet, rng3 As Range, rng4 As Range, lRows As Long, lRows2 As Long, jL

Set ws1 = Sheets("Comparison Sheet")
Set ws2 = Sheets("Comparison Sheet Final")

iL = ws1.Range("A" & Rows.Count).End(xlUp).Row
jL = ws1.Cells(2, Columns.Count).End(xlToLeft).Column

For j = 3 To jL
    Set rng2 = ws1.Range(ws1.Cells(2, j), ws1.Cells(ws1.Cells(Rows.Count, j).End(xlUp).Row, j))
    For i = 2 To iL
        Set rng1 = ws1.Range("A" & i)
        Set var = rng2.Find(rng1.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not var Is Nothing Then
                    rng1.Interior.Color = RGB(255, 255, 0)
                    rng1.Offset(0, 1).Font.Name = "Wingdings"
                    rng1.Offset(0, 1).Value = ChrW(&HFC)
        End If
     
     Next i
    
    ws1.Cells(2, 2) = ws1.Cells(2, j)
    lRows = ws1.Cells(Rows.Count, "A").End(xlUp).Row
    Set rng3 = ws1.Range(ws1.Cells(2, 2), ws1.Cells(lRows, 2))
    lRows2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
    lCols = j - 1

    Set rng4 = ws2.Range(ws2.Cells(2, lCols), ws2.Cells(lRows, lCols))
    rng4.Font.Name = "Wingdings"
    rng4.Value = rng3.Value
    rng3.ClearContents
    ws2.Rows(2).Font.Name = "Calibri"
    
Next j

End Sub

How it currently looks with your code with slight edits

Answer 2

Try this to get to your original need: (Not sure what your sheet names are so you might need to edit to reflect correct sheet.)

Sub CompareAndMove()

Dim rng1 As Range, rng2 As Range, i As Long, iL As Long, var As Range, j As Long, ws1 As Worksheet, Chk As Range, LastDest As Long

Set ws1 = Sheets("Sheet1")
iL = ws1.Range("A" & Rows.Count).End(xlUp).Row

For j = 3 To 5
    Set rng2 = ws1.Range(ws1.Cells(2, j), ws1.Cells(ws1.Cells(Rows.Count, j).End(xlUp).Row, j))
    For i = 2 To iL
        Set rng1 = ws1.Range("A" & i)
        Set var = rng2.Find(rng1.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not var Is Nothing Then
            rng1.Interior.Color = RGB(255, 255, 0)
            rng1.Copy
            rng1.Offset(0, 1).PasteSpecial
        End If
    Next i
    ws1.Range("B2:B" & ws1.Range("B" & Rows.Count).End(xlUp).Row).Copy
    LastDest = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet2").Cells(LastDest, 1).PasteSpecial xlPasteValues
    LastDest = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
    Set rng3 = Sheets("Sheet2").Range("A2:A" & LastDest)
    For each Chk in rng3
        If Len(Chk.Value) = 0 Then
            Chk.EntireRow.Delete xlShiftUp
        End If
    Next Chk
    ws1.Range("B:B").Clear
Next j
End Sub

Answer 3

Sub CompareAndMove()

Dim rng1 As Range, rng2 As Range, i As Long, iL As Long, var As Variant

iL = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To iL
    Set rng1 = Sheets("Sheet1").Range("A" & i)
    Set rng2 = Sheets("Sheet1").Range("C:C")


   var = Application.Match(rng1.Value, rng2, 1)

   If Not IsError(Application.Match(rng1.Value, rng2, 0)) Then
   bln = True

   If bln = True Then

                rng1.Interior.Color = RGB(255, 255, 0)
                rng1.Copy
                rng1.Offset(0, 1).PasteSpecial


    End If
    Set rng1 = Nothing
    Set rng2 = Nothing
    End If

Next i

End Sub