Sub ColorCompanyDuplicates()
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xChar As String
Dim xCellPre As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim I As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
xCIndex = 2
Set xCol = New Collection
For Each xCell In xRg
On Error Resume Next
xCol.Add xCell, xCell.Text
If Err.Number = 457 Then
xCIndex = xCIndex + 1
Set xCellPre = xCol(xCell.Text)
If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.EntireRow.Interior.ColorIndex = xCIndex
xCell.EntireRow.Interior.ColorIndex = xCellPre.EntireRow.Interior.ColorIndex
ElseIf Err.Number = 9 Then
MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
Exit Sub
End If
On Error GoTo 0
Next
End Sub

If b.Value2 = "Чехол для iPhone Xs Max" Then Cells(b.Row, "N") = "50160780"
If b.Value2 = "Чехол-книжка для iPhone Xs Max" Then Cells(b.Row, "N") = "соответствующие цифры"

 =ЛЕВСИМВ(ПРАВСИМВ(A2;(ДЛСТР(A2)-11));(ДЛСТР(ПРАВСИМВ(A2;(ДЛСТР(A2)-11)))-9))

Do
objR.Offset(0, 6) = Range("A1")
set objR.Value = "содержит"

Sub magic()

    Dim a, b, c As Range
    
    Set a = Range("A1:A30")

    For Each b In a
                    
        If b.Value2 = "Оригинальный текст" Then Cells(b.Row, "B") = "нашлось"
        If b.Value2 = "Тут что-то другое" Then Cells(b.Row, "C") = "тоже нашлось"
        If b.Value2 = "А вот тут тоже текст" Then Cells(b.Row, "D") = "и это нашлось, но это же тоже Оригинальный текст"
    
    Next

    Set a = Nothing

    MsgBox "Все дословные совпадения найдены"

Sub color_2()

    Dim rng As Range
    Dim rng2 As Range
    
    Set rng = Range("A1:A30")
    rng.EntireRow.Interior.ColorIndex = -4142
    For Each rng2 In rng
        
        If rng2.Value2 = "раз" Then Cells(rng2.Row, 1).EntireRow.Interior.ColorIndex = 8
        If rng2.Value2 = "два" Then Cells(rng2.Row, 1).EntireRow.Interior.ColorIndex = 6
        
        If rng2.Value2 = "раз" Then Range("B1:B30") = "1"
        If rng2.Value2 = "два" Then Range("B1:B30") = "2"
    Next
    Set rng = Nothing

End Sub

Sub m()
Dim i, n As Long
Range("A1:A500, B1:B500").
For i, n = 1 To 5000
If Cells(i, 1) = Cells(i, n) Then 
If Cells(i, 2) = Cells(i, n) Then 
Next
End Sub