VBA – Data Masking or Anonymize the Data through a Macro

Sometimes, you may need to sanitize your data before sharing your file. The below macro would sanitize the data and since this is completely based on random generation, hence, it can not be recreated.

Make sure that you have a copy of the Excel sheet before you sanitize or mask or anonymize the data by running this data. As once done, the data can not be recreated.

The Excel file related to this article can be downloaded from Data Masking Macro

1. Make a backup of your workbook.
2. Open your workbook and ALT+F11
3. Locate your Workbook name in Project Explorer Window
4. Right click on your workbook name > Insert > Module
5. Copy paste the Macro code given.
6. Select the Range which you want to anonymize
7. Go back to your Workbook and ALT+F8 to display Macro Window
8. Run your Macro from here
9. Delete you Macro if the Macro was needed to be run only once.
10. Otherwise save your file as .xlsm if you intend to reuse Macro again.

(Note – You may choose to save this macro in your personal macro workbook so that this macro is always available to you)

Sub MaskData()
    Dim Cell As Range, Rng As Range
    Dim PN As Long, i As Long
    
    Application.ScreenUpdating = False
    
    If Selection.Cells.Count = 1 Then
        MsgBox "Select more than one Cell"
        Exit Sub
    End If
    If Not TypeOf Selection Is Range Then
        Exit Sub
    End If
    On Error Resume Next
    Set Rng = Selection.SpecialCells(xlConstants)
    On Error GoTo 0
    If Rng Is Nothing Then
        MsgBox "Selected Range does not contain any Data" & vbNewLine _
        & "Please select right range"
        Exit Sub
    End If
    'Provide the seed for random number generation
    Randomize
    
    For Each Cell In Rng
        Select Case True
            Case VarType(Cell) = vbString
                'Extract the Characters into an Array
                Arr = Split(StrConv(Cell, vbUnicode), Chr$(0))
                For i = LBound(Arr) To UBound(Arr)
                    If Arr(i) <> "" Then
                        CharCode = Asc(Arr(i))
                        'Character is between A to Z
                        If CharCode >= 97 And CharCode <= 122 Then
                            Arr(i) = Chr(Int((122 - 97 + 1) * Rnd) + 97)
                            ElseIf CharCode >= 65 And CharCode <= 90 Then
                                Arr(i) = Chr(Int((90 - 65 + 1) * Rnd) + 65)
                            'Character is between 0 to 9
                            ElseIf CharCode >= 48 And CharCode <= 57 Then
                                Arr(i) = Chr(Int((57 - 48 + 1) * Rnd) + 48)
                        End If
                    End If
                Next i
                Cell = Join(Arr, "")
            
            Case VarType(Cell) = vbDate
                On Error Resume Next
                'Generate a random number between 1 and 2 to determine whether
                'to add or subtract the random number
                PN = Int((2 - 1 + 1) * Rnd) + 1
                'Generate a random number between 0 and 9999 and add or subtract this number into the date
                If PN = 1 Then
                    Cell = Cell + Int(10000 * Rnd)
                    Else
                    Cell = Cell - Int(10000 * Rnd)
                End If
                'If error is there, generate a random date between 1-Jan-1990 and 31-Dec-2030
                If Err.Number > 0 Then
                        Cell = Int((DateValue("1-Jan-1990") - DateValue("31-Dec-2030") + 1) * Rnd) + DateValue("31-Dec-2030")
                End If
                On Error GoTo 0
                
            Case IsNumeric(Cell)
            'Extract the Characters into an Array
                Arr = Split(StrConv(CStr(Cell), vbUnicode), Chr$(0))
                'First digit can not be 0
                Arr(LBound(Arr)) = Chr(Int((57 - 49 + 1) * Rnd) + 49)
                For i = LBound(Arr) + 1 To UBound(Arr)
                    If Arr(i) <> "" Then
                        CharCode = Asc(Arr(i))
                        'Character is between 0 to 9
                        If CharCode >= 48 And CharCode <= 57 Then
                            Arr(i) = Chr(Int((57 - 48 + 1) * Rnd) + 48)
                        End If
                    End If
                Next i
                Cell = CDbl(Join(Arr, ""))
        
        End Select
    Next Cell
    Application.ScreenUpdating = True
End Sub