Highlight domain

[KAMRAN AJ]

Hi, hope you are doing great
I need a dyanmic range for active sheet Excel VBA code
that highlight the email column domain and website column domain if the domains are same it hightlihght the same domain ,if the domains are not same dont hightlight or ignore.
i also have attached the screenshot .
I also attached a youtube link i which I explained what I want.https://www.youtube.com/watch?v=xH4o72w-xHw

[georgiboy]

How about something like the attached?

[KAMRAN AJ]

i just want to highlight domain not a entire row

[KAMRAN AJ]

Excellent work

[georgiboy]

Maybe the below for just the domain:

Sub test()
    Dim rCell As Range
    Dim tmp As String
    Dim lStr As String, rStr As String
    
    For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells
        With rCell
            lStr = Left(.Value, InStr(.Value, ".") - 1)
            tmp = Left(.Offset(, 1), InStr(.Offset(, 1), ".") - 1)
            rStr = Right(tmp, Len(tmp) - InStr(tmp, "@"))
            If lStr = rStr Then
                .Characters(InStr(.Value, lStr), Len(lStr)).Font.ColorIndex = 3
                .Offset(, 1).Characters(InStr(.Offset(, 1), lStr), Len(lStr)).Font.ColorIndex = 3
            End If
        End With
        tmp = vbNullString
    Next rCell
End Sub

[KAMRAN AJ]

oh it is
working for me

[KAMRAN AJ]

I appreciate your work . and your code in working for me ,your work is excellent
Please make a changings in code,i want to match the domains of Column B(WEBSITE) with column K(Email)
Please check my screenshot or check my youtube guidance video
make a changes in code.jpg
https://www.youtube.com/watch?v=u5N3c2IMt6s

[Aussiebear]

@Kamran AJ. Try making the changes yourself. In your initial example you were using columns A & B right? So when you look at Georgiboy's code what sticks out as defining Column A and Column B?

Hint 1. Since the below code defines the Range in Column A, what would you consider changing to make it reflect Column B?

For each rCell in Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells

Hint 2. The below code finds the value in Column B of the active row, so what would you change if the column you seek is 9 columns further to the right?

tmp =Left(.Offset(,1), Instr(.Offset(, 1), ".") -1)

[georgiboy]

Maybe:

Sub test()
    Dim rCell As Range
    Dim tmp As String
    Dim lStr As String, rStr As String
    
    For Each rCell In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Cells
        With rCell
            lStr = Left(.Value, InStr(.Value, ".") - 1)
            tmp = Left(.Offset(, 9), InStr(.Offset(, 9), ".") - 1)
            rStr = Right(tmp, Len(tmp) - InStr(tmp, "@"))
            If lStr = rStr Then
                .Characters(InStr(.Value, lStr), Len(lStr)).Font.ColorIndex = 3
                .Offset(, 9).Characters(InStr(.Offset(, 9), lStr), Len(lStr)).Font.ColorIndex = 3
            End If
        End With
        tmp = vbNullString
    Next rCell
End Sub

[KAMRAN AJ]

Thank you so much it is working for me