Option Explicit
Sub trie()
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim i As Long
Dim j As Integer
Range("U3:W3").ClearContents
Range("U5:W65000").ClearContents
For i = 5 To 65536
If Cells(i, 1) = "" Then Exit Sub
For j = 3 To 7
If Cells(i, j) <> Range("J2") And j = 7 Then
Exit For
ElseIf Cells(i, j) = Range("J2") Then
Cells(i, 27) = Range("J2")
Range("K2") = j - 2
For a = 12 To 20
If Cells(i, 3) = Cells(2, a) Then
Cells(i, 28) = Cells(2, a)
Range("L3") = ""
Exit For
ElseIf Range("K2") < 5 And Cells(i, 3) <> Range("J2") Then
Range("L3") = "X"
End If
Next a
For b = 12 To 20
If Cells(i, 4) = Cells(2, b) Then
Cells(i, 29) = Cells(2, b)
Range("M3") = ""
Exit For
ElseIf Range("K2") < 5 And Cells(i, 4) <> Range("J2") Then
Range("M3") = "X"
End If
Next b
For c = 12 To 20
If Cells(i, 5) = Cells(2, c) Then
Cells(i, 30) = Cells(2, c)
Range("N3") = ""
Exit For
ElseIf Range("K2") < 5 And Cells(i, 5) <> Range("J2") Then
Range("N3") = "X"
End If
Next c
For d = 12 To 20
If Cells(i, 6) = Cells(2, d) Then
Cells(i, 31) = Cells(2, d)
Range("O3") = ""
Exit For
ElseIf Range("K2") < 5 And Cells(i, 6) <> Range("J2") Then
Range("O3") = "X"
End If
Next d
For e = 12 To 20
If Cells(i, 7) = Cells(2, e) Then
Cells(i, 32) = Cells(2, e)
Range("P3") = ""
Exit For
ElseIf Range("K2") < 5 And Cells(i, 7) <> Range("J2") Then
Range("P3") = "X"
End If
Next e
Cells(i, 26).FormulaR1C1 = _
"=COUNT(RC[1],RC[2],RC[3],RC[4],RC[5],RC[6],RC[7],RC[8],RC[9],RC[10],RC[11],RC[12])"
If Cells(i, 26) = 5 Then
Cells(i, 22) = Cells(i, 9)
Cells(i, 23) = Cells(i, 22)
End If
If Cells(i, 26) = 5 And Range("K2") < 5 Then
Cells(i, 21) = Cells(i, 8)
Cells(i, 23) = Cells(i, 21) + Cells(i, 22)
End If
If Cells(i, 26) = 4 And Range("K2") < 5 And Range("L3") = "" And Range("M3") = "" And Range("N3") = "" And _
Range("O3") = "" Then
Cells(i, 21) = Cells(i, 8)
Cells(i, 23) = Cells(i, 21) + Cells(i, 22)
Range("U3").Select
ActiveCell.FormulaR1C1 = "=SUM(R[2]C:R[65000]C)"
Range("V3").Select
ActiveCell.FormulaR1C1 = "=SUM(R[2]C:R[65000]C)"
Range("W3") = Range("U3") + Range("V3")
End If
Range(Cells(i, 26), Cells(i, 36)).ClearContents
Range("K2:K3").ClearContents
Range("L3:P3").ClearContents
End If
Next j
Next i
End Sub