vba compare between two sheets and highlight new items

Hi experts ,
I put the result in column column D,E for sheet2 and highlighted new item for sheet1,2
so current code compares data between two sheets based on column B , subtraction numeric values between two sheets and result show in column E for sheet2 , if the values are positive or negative then will be in column D wrong mark for adjacent cell and if the value is zero or empty in column E will be in column D right mark and if there new item is existed in sheet but it's not in the other will highlight the item by red . if the item is in existed in sheet1 , but it's not existed in sheet2 the value in column E is negative, if the item is in existed in sheet2 but not in sheet1 the value in column E is positive
so I want replace formula in column D with vba procedure and highlight new items between two sheets .
should copy highlighted data from sheet1 to sheet2 to become as I put in rang I: M but the result should be in range A:E

Sub UpdateSheet2()
Dim LR As Long

With Sheets("Sheet2")
    LR = .Range("B" & .Rows.Count).End(xlUp).Row
    With .Range("E2:E" & LR)
        .Formula = "=IF(ISNUMBER(MATCH(B2, Sheet1!B:B, 0)), C2 - VLOOKUP(B2, Sheet1!B:C, 2, 0), C2)"
        
        .Value = .Value

      
    End With
    
End With

End Sub

thanks

Try this code.

Sub UpdateSheet2w()
Dim LR As Long, c As Range, k&, i&, j&, nx&, x&, r&
Dim s1 As Worksheet, s2 As Worksheet
Dim d As Object, dd As Object, a

Set s1 = Sheets("sheet1")
Set s2 = Sheets("sheet2")
Application.ScreenUpdating = False
a = s1.[A1].Offset(1).CurrentRegion

Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
    For i = LBound(a) To UBound(a)
        If Not d.exists(a(i, 2)) Then
            d.Add a(i, 2), k
            k = k + 1
        End If
    Next i
For i = LBound(a) To UBound(a)
    For x = 2 To s2.Range("B" & s2.Rows.Count).End(xlUp).Row
        If Not dd.exists(s2.Cells(x, 2).Value) Then
            dd.Add s2.Cells(x, 2).Value, r
            r = r + 1
        End If
        If s2.Cells(x, 2).Value = a(i, 2) Then
            s2.Cells(x, 5).Value = s2.Cells(x, 3).Value - a(i, 3)
            If s2.Cells(x, 5).Value = 0 Then
                s2.Cells(x, 4).Value = Chr(252)
            Else
                s2.Cells(x, 4).Value = Chr(251)
            End If
        x = x + 1
        End If
    Next
Next
    nx = s2.Range("B" & s2.Rows.Count).End(xlUp).Row + 1
    For j = 2 To UBound(a)
        If Not dd.exists(a(j, 2)) Then
            s2.Cells(nx, 1).Value = s2.Cells(nx - 1, 1).Value + 1
            s2.Cells(nx, 2).Value = a(j, 2)
            s2.Cells(nx, 3).Value = a(j, 3)
            s2.Cells(nx, 4).Value = Chr(251)
            s2.Cells(nx, 4).Font.Name = "Wingdings"
            s2.Cells(nx, 5).Value = -a(j, 3)
            s2.Range("A" & nx & ":E" & nx).Interior.ColorIndex = 3 ' red 10 ' green
            s2.Range("A" & nx & ":E" & nx).Borders.Weight = xlThin
            s2.Range("A" & nx & ":D" & nx).HorizontalAlignment = xlCenter
        nx = nx + 1
        End If
    Next j
For x = 2 To s2.Range("B" & s2.Rows.Count).End(xlUp).Row
    If IsEmpty(s2.Cells(x, 5)) Then
        s2.Cells(x, 4).Value = Chr(251)
        s2.Cells(x, 4).Font.Name = "Wingdings"
        s2.Cells(x, 5).Value = s2.Cells(x, 3).Value
        s2.Range("A" & x & ":E" & x).Interior.ColorIndex = 43 ' lt green
    End If
Next

Application.ScreenUpdating = True
End Sub

Try this update.

Sub UpdateSheet2x()
Dim LR As Long, c As Range, k&, i&, j&, nx&, x&, r&, n&, xx&
Dim s1 As Worksheet, s2 As Worksheet
Dim d As Object, dd As Object, a

Set s1 = Sheets("sheet1")
Set s2 = Sheets("sheet2")
Application.ScreenUpdating = False
a = s1.[A1].Offset(1).CurrentRegion
n = s2.Range("B" & s2.Rows.Count).End(xlUp).Row
For i = n To 1 Step -1
    If s2.Cells(i, 1).Interior.ColorIndex = 3 Then '3 = Red
        s2.Rows(i).Delete
    End If
Next
xx = s2.Range("B" & s2.Rows.Count).End(xlUp).Row
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
    For i = LBound(a) To UBound(a)
        If Not d.exists(a(i, 2)) Then
            d.Add a(i, 2), k
            k = k + 1
        End If
    Next i
For i = LBound(a) To UBound(a)
    For x = 2 To xx
        If Not dd.exists(s2.Cells(x, 2).Value) Then
            dd.Add s2.Cells(x, 2).Value, r
            r = r + 1
        End If
        If s2.Cells(x, 2).Value = a(i, 2) Then
            s2.Cells(x, 5).Value = s2.Cells(x, 3).Value - a(i, 3)
            If s2.Cells(x, 5).Value = 0 Then
                s2.Cells(x, 4).Value = Chr(252)
            Else
                s2.Cells(x, 4).Value = Chr(251)
            End If
            s2.Cells(x, 4).Font.Name = "Wingdings"
        x = x + 1
        End If
    Next
Next
    nx = xx + 1
    For j = 2 To UBound(a)
        If Not dd.exists(a(j, 2)) Then 'And s2.Cells(nx, 1).Interior.ColorIndex <> 3 Then
            s2.Cells(nx, 1).Value = s2.Cells(nx - 1, 1).Value + 1
            s2.Cells(nx, 2).Value = a(j, 2)
            s2.Cells(nx, 3).Value = a(j, 3)
            s2.Cells(nx, 4).Value = Chr(251)
            s2.Cells(nx, 4).Font.Name = "Wingdings"
            s2.Cells(nx, 5).Value = -a(j, 3)
            s2.Range("A" & nx & ":E" & nx).Interior.ColorIndex = 3 ' red 10 ' green
            s2.Range("A" & nx & ":E" & nx).Borders.Weight = xlThin
            s2.Range("A" & nx & ":D" & nx).HorizontalAlignment = xlCenter
        nx = nx + 1
        End If
    Next j
For x = 2 To nx - 1
    If IsEmpty(s2.Cells(x, 5)) Or s2.Range("A" & x & ":E" & x).Interior.ColorIndex = 43 Then
        s2.Cells(x, 4).Value = Chr(251)
        s2.Cells(x, 4).Font.Name = "Wingdings"
        s2.Cells(x, 5).Value = s2.Cells(x, 3).Value
        s2.Range("A" & x & ":E" & x).Interior.ColorIndex = 43 ' lt green
    End If
Next
Application.ScreenUpdating = True
End Sub

thanks
now everything is ok , just I have question when update the data in sheet and become the changed data are matched with data have already highlighted before , then should delete the color to become xl None or delete the whole red highlighted range when become matched after update or change between two sheets , is there way to do this case?