Solved: Routine to replace all cells with gibberish

[Gingertrees]

Hello,

In reference to XLD's recommendation:
http://www.vbaexpress.com/forum/showthread.php?t=28382
I need to make a simple routine I can run on the ActiveSheet to change text cells that do NOT have a formula in them to gibberish (or blank would be ok too). I need to do this so I can post my workbook to hopefully get help with some other issues.

I found two code snippets that both have aspects of what I want to do:


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.row = 1 Then Exit Sub
If Target.HasFormula Then Exit Sub
'/////I definitely want that part, as my questions revolve around one sheet messing up other sheets' formulas!///

On Error GoTo ErrHandler
Application.EnableEvents = False
If Target.Column = 1 Then
Target.Value = Trim(Replace(Replace(Target.Value, "*", " "), "!", " "))
End If
ErrHandler:
Application.EnableEvents = True
End Sub

Sub StripL2()
'Strip left two positions from cell in selection range
'SpecialCells will limit the range to the used area within
Dim cell As Range
For Each cell In Selection.SpecialCells(xlConstants)
cell.Value = Mid(cell.Value, 3)
Next cell

'///this seems like the simplest way, but I get runtime errors when_

'////I tell it "For Each Cell in ActiveSheet"End Sub


Ideas?

[Bob Phillips]

Why is it worksheet change event, shouldn't it be a linear batch process?

I was thinking about this, and I thought it would be best to insert a row at the top, and add an entry for all columns to be obfuscated. So, for instance, if it had 'Name' at the top, each entry in taht column would be changed to Name #1, Name #2 etc. If it had Number<7>, you would generate a random number up to 9999999. If it had Decimal<5,2> you would generate numbers up 99999.99, and so on. If row 1 was blank, that column gets ignored.

You also have to be careful that if a value is repeated it gets changed to the same that the previous instance of tha value was changed to, maybe not important for n umbers, but very important for names, ids etc.

Here is a quick shot I had at it


Option Explicit

Public Type ApplicationValues
ScreenUpdating As Boolean
Calculation As XlCalculation
End Type

Private AppValues As ApplicationValues

Public Sub ObfuscateData()
Dim mpDataType As String
Dim mpDataSubtype As String
Dim mpCurrencySymbol As String
Dim mpDataDigits As Long
Dim mpDataPlaces As Long
Dim mpNextItem As Long
Dim mpLastRow As Long
Dim mpLastCol As Long
Dim i As Long, j As Long

With Application

AppValues.ScreenUpdating = .ScreenUpdating
AppValues.Calculation = .Calculation

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

On Error GoTo OD_exit

With ActiveSheet

mpLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For j = 1 To mpLastCol

mpDataType = .Cells(1, j).Value
mpNextItem = 0

Select Case True

Case mpDataType Like "Number*"
mpDataDigits = Mid$(mpDataType, InStr(mpDataType, "<") + 1, InStr(mpDataType, ">") - InStr(mpDataType, "<") - 1)

Case mpDataType Like "Decimal*"
mpDataDigits = Mid$(mpDataType, InStr(mpDataType, "<") + 1, InStr(mpDataType, ",") - InStr(mpDataType, "<") - 1)
mpDataPlaces = Mid$(mpDataType, InStr(mpDataType, ",") + 1, InStr(mpDataType, ">") - InStr(mpDataType, ",") - 1)

Case mpDataType Like "Currency*"
mpCurrencySymbol = Mid$(mpDataType, InStr(mpDataType, "<") + 1, InStr(mpDataType, ",") - InStr(mpDataType, "<") - 1)
mpDataDigits = Mid$(mpDataType, InStr(mpDataType, ",") + 1, InStr(mpDataType, ">") - InStr(mpDataType, ",") - 1)
End Select

If mpDataType <> "" Then

mpLastRow = .Cells(.Rows.Count, j).End(xlUp).Row
For i = 2 To mpLastRow

If Not IsError(.Cells(i, j).Value) Then

If Not .Cells(i, j).Value Like "Obfuscated*" Then

mpNextItem = mpNextItem + 1
Select Case True

Case mpDataType Like "Number<*"
.Columns(j).Replace What:=.Cells(i, j).Value, _
Replacement:="Obfuscated" & (Rnd() * 10 ^ mpDataDigits \ 1), _
LookAt:=xlWhole, _
SearchOrder:=xlByRows

Case mpDataType Like "Decimal<*"
.Columns(j).Replace What:=.Cells(i, j).Value, _
Replacement:="Obfuscated" & (Rnd() * 10 ^ mpDataDigits + mpDataPlaces \ 10 ^ mpDataPlaces), _
LookAt:=xlWhole, _
SearchOrder:=xlByRows
.Cells(2, j).Resize(mpLastRow - 1).NumberFormat = "#,###." & String(mpDataPlaces, "0")

Case mpDataType Like "Currency<*"
.Columns(j).Replace What:=.Cells(i, j).Value, _
Replacement:="Obfuscated" & (Rnd() * 10 ^ mpDataDigits + 2 \ 100), _
LookAt:=xlWhole, _
SearchOrder:=xlByRows
.Cells(2, j).Resize(mpLastRow - 1).NumberFormat = mpCurrencySymbol & "#,###.00"

Case Else
.Columns(j).Replace What:=.Cells(i, j).Value, _
Replacement:="Obfuscated" & mpDataType & " #" & mpNextItem, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows
End Select
End If
End If
Next i
End If
Next j

.UsedRange.Replace What:="Obfuscated", _
Replacement:="", _
LookAt:=xlPart, _
SearchOrder:=xlByRows

.Rows(1).Delete
End With

OD_exit:
With Application

.ScreenUpdating = AppValues.ScreenUpdating
.Calculation = AppValues.Calculation
End With
End Sub

[Gingertrees]

I think there may be an error in there - excel doesn't like Private AppValues As ApplicationValues.

I tried removing that line, leaving just "Public Sub ObfuscateData()" but I didn't know what I should define AppValues as. String? Boolean? ????

I wish this language made any sense to me at al...

[Bob Phillips]

Where did you put the code?

[mikerickson]

If blank is OK
Cells.SpecialCells(xlCellTypeConstants, xlTextValues).ClearContents

[Gingertrees]

XLD: I put the code in ThisWorkbook module.

mikerickson: That looks simple. How do I make that work? Is it a private sub, public, in ThisWorkbook, sheet, etc? Does it avoid formulas?

[Bob Phillips]

It should go in a standard code module. Insert a definition row in row 1, and then run it.

[Gingertrees]

Not sure where I was supposed to do that...or what I'm supposed to define it AS. Wouldn't let me at the top, I added "Dim Row as Long" right under Public Sub ObfuscateData(), and came up with the following Compile Error:
"Cannot define a Public user-defined type within an object module"

?????

[mikerickson]

That line of code should go in a Sub in a normal module
Put this in a normal module (not a Class Module or ThisWorkbook)
Sub test()
Cells.SpecialCells(xlCellTypeConstants, xlTextValues).ClearContents
End Sub

"Does it avoid formulas"? VBEditor Help will explain the .SpecialCells property.

[Bob Phillips]

Look here

[Simon Lloyd]

Bob thats brilliant!, mind if i steal it?

[Bob Phillips]

Feel free, it's in the public domain now.

There is one major improvement that it needs, but this won't be easy. If there is a formula that refers to data somewhere else on the spreadsheet, that table needs to be obfuscated too, but in a smart way. For instance, say that there is a lookup table of names Bob, Simon and Gingertrees, and there is a formula somewhere of =VLOOKUP(A20,lookup_table,2,FALSE). If A20 is opne of those values and that column gets obfuscated, then that previous value in the lookup table should change to the same value that A20 switches too. Trouble is that it isn't only VLOOKUP, it is LOOKUP, HLOOKUP, COUNTIF, and so on. Tough!

[Simon Lloyd]

I see, not only tough but a lot of code, i'll have a go at an array for it (could make the code run a long time on large sheets), i know nothing of RegEx but can it be used in this instance?

[Simon Lloyd]

Bob, i just re-read you post....i'm talking through the top of my head!

I see where your coming from, the value that was obfuscated in the first sheet needs to have the same value on Sheet2 ...etc, i think the code will be slow as for each value there will have to be a find and replace, unless we store the previous list and then obfuscate on the subsequent sheet with the new values from the first....does that make sense?, i just read it back and im not sure :)

EDIT: it wouldn't matter for names so much as the obfuscation is linear, but currency and numbers will be the problem!

[Bob Phillips]

Numeric values wouldn't be (shouldn't be) a problem, I can't see them being looked up, and if they are processed in other functions (such as SUM), it should not matter - who cares whether we add 20 or 200, it should not be material to the application. So, as I see it, it would be just text values that we have to worry about (just - that's a laugh, it is still not simple).

It is actually worse if the values are used elsewhere say by a code event update, there is no way in my code to recognise that. My current thinking is that the best way to do this would be to capture all of the old and new values in a couple of arrays, and once all of the user identified processing is complete, go through and lookup and change any other values - could take a bit of time though.

[Gingertrees]

Thanks for everyone's input! XLD, you did create great code that works well for tables and spreadsheets of data. I may be able to use that for some other projects I'm working on when I get stuck.

mikerickson: Since most of my sheets are less orderly, with lots of text, your simple subroutine works for my needs. Thank you thank you thank you!!!

[Bob Phillips]

I have updated my app along the lines of my last suggeston, so it caters for associated values as well now. In the workbook I have a lookup table and some values on a second sheet, all get updated the same as the core data.

[Simon Lloyd]

I have updated my app along the lines of my last suggeston, so it caters for associated values as well now. In the workbook I have a lookup table and some values on a second sheet, all get updated the same as the core data.Something that intrigued you? lol

[Bob Phillips]

Yeah, I even blogged it.