Function dhReverseText(strText As String) As String
Dim i As Integer

For i = Len(strText) To 1 Step -1
dhReverseText = dhReverseText & Mid(strText, i, 1)
Next i
End Function

Function strAmino(strNukle As String) As String
Dim i As Integer, rez As String
For i = 1 To Len(strNukle) Step 1
    Select Case Mid(strNukle, i, 1)
        Case "G": rez = rez & "C"
        Case "C": rez = rez & "G"
        Case "T": rez = rez & "A"
        Case "A": rez = rez & "T"
    End Select
 Next i
strAmino = rez
End Function

Function GetHash(ByVal txt$) As String     Dim oUTF8, oMD5, abyt, i&, k&, hi&, lo&, chHi$, chLo$     Set oUTF8 = CreateObject("System.Text.UTF8Encoding")     Set oMD5 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")     abyt = oMD5.ComputeHash_2(oUTF8.GetBytes_4(txt$))     For i = 1 To LenB(abyt)         k = AscB(MidB(abyt, i, 1))         lo = k Mod 16: hi = (k - lo) / 16         If hi > 9 Then chHi = Chr(Asc("a") + hi - 10) Else chHi = Chr(Asc("0") + hi)         If lo > 9 Then chLo = Chr(Asc("a") + lo - 10) Else chLo = Chr(Asc("0") + lo)         GetHash = GetHash & chHi & chLo     Next     Set oUTF8 = Nothing: Set oMD5 = Nothing End Function

Private Sub Worksheet_Change(ByVal Target As Range)
Const SRange = "D6:E341"
Const DRange = "p2:ae31"
If Not Intersect(Target, Range(DRange)) Is Nothing Or _
    Not Intersect(Target, Range(SRange)) Is Nothing Then
    On Error Resume Next
    For Each cell In Range(DRange)
        cell.Interior.Color = Range(SRange).Find(What:=cell.Value, LookAt:=xlWhole).Offset(, 1).DisplayFormat.Interior.Color
        If Err <> 0 Then
            Err.Clear
            cell.Interior.Color = vbWhite
        End If
    Next
End If
End Sub