Option Explicit
Sub EnkripcijaDekripcija()
Dim r As Range, retVal, sKey As String
sKey = Application.InputBox("Unesite svoj ključ", "Unos ključa", "Moj ključ", , , , , 2)
retVal = MsgBox("Unijeli ste ovaj ključ:" & vbNewLine & Chr$(34) & sKey & Chr$(34) & vbNewLine & _
        "Potvrdite pritiskom na dugme OK ili poništite pritiskom na dugme Cancel", vbOKCancel, "Potvrda ključa")
If retVal = vbCancel Then Exit Sub
For Each r In Sheets("Sheet1").UsedRange
    If r.Interior.ColorIndex = 6 Then
        r.Value = XorC(r.Value, sKey)
    End If
Next r
End Sub

Function XorC(ByVal sData As String, ByVal sKey As String) As String
    Dim l As Long, i As Long, byIn() As Byte, byOut() As Byte, byKey() As Byte
    Dim bEncOrDec As Boolean

    If Len(sData) = 0 Or Len(sKey) = 0 Then XorC = "Provjerite sadržaj ili ključ": Exit Function

    If Left$(sData, 3) = "xxx" Then
        bEncOrDec = False   'dekripcija
        sData = Mid$(sData, 4)
    Else
        bEncOrDec = True   'enkripcija
    End If
    
    byIn = sData
    byOut = sData
    byKey = sKey
    l = LBound(byKey)
    For i = LBound(byIn) To UBound(byIn) - 1 Step 2
        byOut(i) = ((byIn(i) + Not bEncOrDec) Xor byKey(l)) - bEncOrDec
        l = l + 2
        If l > UBound(byKey) Then l = LBound(byKey)
    Next i
    XorC = byOut
    If bEncOrDec Then XorC = "xxx" & XorC
End Function