Redacting a list of names in Excel

[pudgybulge]

Dear Forum!

I have an excel problem which I could not figure out even after hours of searching. I hope you can help me here!

I have a thousand rows of names with varying lengths which I need to redact in excel. For example:

Andy Lee
Nora Jones
James Watson
Brian de Jonas Graham

And I need to convert to the following format:

And* Lee
Nor* **nes
Jam** ***son
Bri** ** ***** ***ham

OR

And*-Lee
Nor*-**nes
Jam**-***son
Bri**-**-*****-***ham


Anybody has an idea how to do this? I need to provide the first 3 letters and last 3 letters of every name, and replace all letters in between with "*", but have to leave the spacing. Or if I can convert the spaces to "-", that would be useful too


Thanks!

 

[Fennek]

Hi,

from a pure technical point of view: using RegularExpression this taks can be done, supposingly fairla easy.

regards

(I have no intention to write a code)

 

[Rick Rothstein]

Here is a macro that should work for you. The macro assumes your first name is in cell A1 and it outputs its results to Column B starting on Row 1...

Sub RedactNames()
  Dim R As Long, X As Long, Data As Variant
  Data = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  For R = 1 To UBound(Data)
    For X = 3 To Len(Data(R, 1)) - 3
      If Mid(Data(R, 1), X, 1) Like "[! ]" Then Mid(Data(R, 1), X) = "*"
    Next
  Next
  Range("B1").Resize(UBound(Data)) = Data
End Sub

 

[mole999]

if you are redacting, you don't really want people to identify a person from the shape of their name

maybe get a left and right value and add *, you might do that in a formula in an associated column

=TRIM(LOWER(LEFT(A1,3)&"******"&RIGHT(A1,3)))

 

[Fennek]

Hi,

the Name is in A1, the output in the VBA-direct-window:

Sub Fen_R()
With CreateObject("vbscript.regexp")
Tx = Cells(1, 1)
.Global = True
.Pattern = "(^\w{3})(.*?)(\w{3})$"

Set RR = .Execute(Tx)

For Each R In .Execute(Tx)
    For Each SM In R.Submatches
        If i <> 1 Then F00 = F00 & SM
        If i = 1 Then
            .Pattern = "\w"
            neu = .Replace(SM, "*")
            F00 = F00 & neu
        End If
        i = i + 1
    Next SM
Next R
End With
Debug.Print F00
End Sub

regards

 

[pudgybulge]

Thanks everyone!!! The above suggestions all workout at the end for me.

Much appreciated. I hope other users would find them useful too