Secure Excel Data Obfuscation

Initialize the macro and declare variables

Sub ObfuscateExcelData()
    ' Obfuscates numbers while preserving Excel formulas and structure
    ' Only modifies constant numeric values, not formulas or text
    
    Dim ws As Worksheet
    Dim cell As Range
    Dim processedCells As Long
    Dim startTime As Double
    
    ' Start timing for performance measurement
    startTime = Timer
    
    ' Show progress indicator to user
    Application.ScreenUpdating = False
    Application.StatusBar = "Starting obfuscation process..."

Process each worksheet and cell

    ' Process each worksheet in the workbook
    For Each ws In ActiveWorkbook.Worksheets
        Application.StatusBar = "Processing worksheet: " & ws.Name
        
        ' Skip hidden worksheets to preserve workbook structure
        If ws.Visible = xlSheetVisible Then
            ' Process cells with values in the used range only
            For Each cell In ws.UsedRange.Cells
                ' Only process cells containing numeric constants (not formulas)
                If Not cell.HasFormula And IsNumeric(cell.Value) Then
                    ' Obfuscate the cell value while preserving format and magnitude
                    cell.Value = ObfuscateNumber(cell.Value)
                    processedCells = processedCells + 1
                End If
            Next cell
        End If
    Next ws

Show completion statistics

    ' Reset application settings and show completion message
    Application.StatusBar = False
    Application.ScreenUpdating = True
    
    ' Display completion message with statistics
    MsgBox "Obfuscation complete!" & vbCrLf & _
           processedCells & " cells processed in " & _
           Format(Timer - startTime, "0.00") & " seconds." & vbCrLf & vbCrLf & _
           "Your data structure, formulas and formats are preserved, but the" & _
           " numeric values have been obfuscated.", vbInformation
End Sub

Obfuscation function - transforms numbers while preserving magnitude

Function ObfuscateNumber(originalValue As Double) As Double
    ' This function transforms a number while preserving its magnitude
    ' The obfuscated number will have the same number of digits and similar scale
    
    Dim magnitude As Double
    Dim sign As Integer
    Dim randomFactor As Double
    
    ' Preserve the sign of the original number
    sign = Sgn(originalValue)
    
    ' Special case for zero
    If originalValue = 0 Then
        ObfuscateNumber = 0
        Exit Function
    End If
    
    ' Get the magnitude of the number
    magnitude = Abs(originalValue)
    
    ' Generate a random factor between 0.7 and 1.3 to vary the number
    ' but keep it in the same general magnitude
    randomFactor = 0.7 + (Rnd * 0.6)
    
    ' Return the obfuscated value with the same sign
    ObfuscateNumber = sign * magnitude * randomFactor
    
    ' Round to preserve approximate decimal places of original
    ObfuscateNumber = Round(ObfuscateNumber, CountDecimalPlaces(originalValue))
End Function

Helper function to count decimal places

Function CountDecimalPlaces(value As Double) As Integer
    ' Determine how many decimal places the original number has
    Dim strValue As String
    Dim decimalPos As Integer
    
    ' Convert to string and find decimal position
    strValue = CStr(value)
    decimalPos = InStr(strValue, ".")
    
    ' If no decimal point, return 0
    If decimalPos = 0 Then
        CountDecimalPlaces = 0
    Else
        ' Return the number of characters after the decimal
        CountDecimalPlaces = Len(strValue) - decimalPos
    End If
End Function