Private Sub Worksheet_Change(ByVal Target As Range)
' On Error Resume Next
Dim sCa As String, sBoFan As String: Dim bWw As Byte
Dim RngCa As Range, RngBF As Range
If Not Intersect(Target, [e3]) Is Nothing Or Not Intersect(Target, [b3]) Is Nothing Then
If [e3] = "" Or [b3] = "" Then
Exit Sub
Else
sCa = [b3]: sBoFan = [e3]
Set RngBF = Columns("J:J").Find(what:=sCa, LookIn:=xlValues)
If Not RngBF Is Nothing Then _
Set RngCa = Range(RngBF, RngBF.End(xlDown))
Set RngBF = RngCa.Find(what:=sBoFan, LookIn:=xlValues)
If Not RngBF Is Nothing Then
bWw = Cells(RngBF.Row, 255).End(xlToLeft).Column
Set RngCa = RngBF.Offset(, 1).Resize(1, bWw - RngBF.Column)
Range(Cells(1, RngBF.Column), Cells([j65432].End(xlUp).Row, _
bWw)).Interior.ColorIndex = 0
RngCa.Interior.ColorIndex = 35
End If
Range("A6:A" & bWw).Clear
For Each RngBF In RngCa
Range("A" & [A65432].End(xlUp).Row + 1) = RngBF
Next RngBF
End If
End If
End Sub
