Scramble the values of individual cells in an Excel Spreadsheet


Just out of curiosity I went off and had a look for a function that does the same for excel spreadsheets as my previous post did for databases.

Here’s a function that will work.

Public Function Scramble(Optional ByRef UserText As Variant, Optional ByRef Everytime As Variant) As String

    On Error GoTo ScrambleError

    Dim i As Long
    Dim Num As Long
    Dim NewPosition As Long
    Dim Temp As String


    If IsMissing(UserText) Then
    Scramble = "No data"

     Exit Function
    ' No quotes automatically generates an error from the worksheet.


    ElseIf IsError(UserText) Then
    Scramble = "Error - try adding quote marks around your entry."
    Exit Function
    End If


    Application.Volatile (Not IsMissing(Everytime))
    If TypeName(UserText) = "Range" Then UserText = UserText(1).Value
    Num = Len(UserText)
    If Num > 0 Then
    For i = 1 To Num
    Temp = Mid$(UserText, i, 1)
    NewPosition = Int(Num * Rnd + 1)
    Mid$(UserText, i, 1) = Mid$(UserText, NewPosition, 1)
    Mid$(UserText, NewPosition, 1) = Temp
    Next ' i
    Scramble = UserText


    Scramble = "No data" 'Can result from entering ""
    End If
    Exit Function


    Scramble = "Error " & Err.Number

End Function