Have you ever needed to scrable, mix up, shuffle a string? Well I did for a project and surprisingly couldn’t quickly find anything when I Googled the subject so below is a very simple function that I devised to do exactly that. The function simply takes an input string, reorders the characters and outputs the resulting string. So the output is of the same length and contains the exact same characters, just in a different order.

'---------------------------------------------------------------------------------------
' Procedure : ShuffleString
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Shuffle the characters within a string
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
'             Requires the GetRndNo Function found at:
'             http://www.devhut.net/2017/02/09/vba-generate-a-random-number-between-two-numbers/
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sInput    : Initial string to mix up
'
' Usage:
' ~~~~~~
' sNewString = ShuffleString("abcdef")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2018-07-11              Initial Public Release
'---------------------------------------------------------------------------------------
Public Function ShuffleString(ByVal sInput As String) As String
    On Error GoTo Error_Handler
    Dim coll                  As Collection
    Dim lStringLen            As Long
    Dim i                     As Long
    Dim lStringLenLeft        As Long
    Dim lEleNo                As Long

    lStringLen = Len(sInput)

    Set coll = New Collection
    For i = 1 To lStringLen
        coll.Add Mid(sInput, i, 1)
    Next i

    lStringLenLeft = lStringLen + 1
    For i = 1 To lStringLen
        Randomize
        lStringLenLeft = lStringLenLeft - 1
        lEleNo = GetRndNo(1, lStringLenLeft)
        ShuffleString = ShuffleString & coll(lEleNo)
        coll.Remove (lEleNo)
    Next i

Error_Handler_Exit:
    On Error Resume Next
    If Not coll Is Nothing Then Set coll = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ShuffleString" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function