find and replace numeric strings in larger text strings

[Mr Molio]

Looking for a way, formula or macro, to search thru a cell and find
user account numbers within the text string of the cell. Once found, I
want to replace them with x's. This will basically be a 'scrub'
function to mask account numbers from view but keep the rest of the
cell's content intact. Here are some parameters:

1) each account number is 10 digits long, all numeric characters
2) ANY string within a cell that is 10 consecutive numeric characters
WILL be an account number
3) Account numbers are in no particular position within the cell. The
contents of the cell come from a chat log with customers, and they may
have typed the account number at any point in the string.

Once found, in each cell, I'd like to simply replace the numeric
characters with x's.

Any help is appreciated!

C

 

[James Ravenswood]

Looking for a way, formula or macro, to search thru a cell and find
user account numbers within the text string of the cell. Once found, I
want to replace them with x's. This will basically be a 'scrub'
function to mask account numbers from view but keep the rest of the
cell's content intact. Here are some parameters:

1) each account number is 10 digits long, all numeric characters
2) ANY string within a cell that is 10 consecutive numeric characters
WILL be an account number
3) Account numbers are in no particular position within the cell. The
contents of the cell come from a chat log with customers, and they may
have typed the account number at any point in the string.

Once found, in each cell, I'd like to simply replace the numeric
characters with x's.

Any help is appreciated!

C

Try this small UDF:

Function IDKiller(s As String) As String
Dim L As Long, i As Long
Dim J As Long, JJ As Long
L = Len(s)
ReDim ary(1 To L)
For i = 1 To L
ary(i) = Mid(s, i, 1)
Next
kount = 0
J = 0
JJ = 0
For i = 1 To L
If ary(i) Like "#" Then
kount = kount + 1
If J = 0 Then J = i
JJ = i
If kount = 10 Then Exit For
Else
kount = 0
J = 0
JJ = 0
End If
Next

If kount = 10 Then
For jjj = J To JJ
ary(jjj) = "x"
Next
End If
IDKiller = ""
For i = 1 To L
IDKiller = IDKiller & ary(i)
Next
End Function


So if A1 contained:
dh11aks4jdhsjh1234567890675
=IDKiller(A1) will return:
dh11aks4jdhsjhxxxxxxxxxx675



User Defined Functions (UDFs) are very easy to install and use:

1. ALT-F11 brings up the VBE window
2. ALT-I
ALT-M opens a fresh module
3. paste the stuff in and close the VBE window

If you save the workbook, the UDF will be saved with it.

To remove the UDF:

1. bring up the VBE window as above
2. clear the code out
3. close the VBE window

To use the UDF from Excel:

=myfunction(A1)

To learn more about macros in general, see:

http://www.mvps.org/dmcritchie/excel/getstarted.htm

or

http://www.cpearson.com/excel/WritingFunctionsInVBA.aspx
for specifics on UDFs

 

[Don Guillett]

Looking for a way, formula or macro, to search thru a cell and find
user account numbers within the text string of the cell. Once found, I
want to replace them with x's. This will basically be a 'scrub'
function to mask account numbers from view but keep the rest of the
cell's content intact. Here are some parameters:

1) each account number is 10 digits long, all numeric characters
2) ANY string within a cell that is 10 consecutive numeric characters
WILL be an account number
3) Account numbers are in no particular position within the cell. The
contents of the cell come from a chat log with customers, and they may
have typed the account number at any point in the string.

Once found, in each cell, I'd like to simply replace the numeric
characters with x's.

Any help is appreciated!

C

If you have one customer number such as 12345, simply use
edit>replace>12345 with xxxxx. If more use a looping macro. If ANY
number, that is different

 

[Mr Molio]

Try this small UDF:

Function IDKiller(s As String) As String
Dim L As Long, i As Long
Dim J As Long, JJ As Long
L = Len(s)
ReDim ary(1 To L)
For i = 1 To L
    ary(i) = Mid(s, i, 1)
Next
kount = 0
J = 0
JJ = 0
For i = 1 To L
    If ary(i) Like "#" Then
        kount = kount + 1
        If J = 0 Then J = i
        JJ = i
        If kount = 10 Then Exit For
    Else
        kount = 0
        J = 0
        JJ = 0
    End If
Next

If kount = 10 Then
    For jjj = J To JJ
        ary(jjj) = "x"
    Next
End If
IDKiller = ""
For i = 1 To L
    IDKiller = IDKiller & ary(i)
Next
End Function

So if A1 contained:
dh11aks4jdhsjh1234567890675
=IDKiller(A1) will return:
dh11aks4jdhsjhxxxxxxxxxx675

User Defined Functions (UDFs) are very easy to install and use:

1. ALT-F11  brings up the VBE window
2. ALT-I
    ALT-M opens a fresh module
3. paste the stuff in and close the VBE window

If you save the workbook, the UDF will be saved with it.

To remove the UDF:

   1. bring up the VBE window as above
   2. clear the code out
   3. close the VBE window

To use the UDF from Excel:

=myfunction(A1)

To learn more about macros in general, see:

http://www.mvps.org/dmcritchie/excel/getstarted.htm

or

http://www.cpearson.com/excel/WritingFunctionsInVBA.aspx
for specifics on UDFs

That works great!! Thanks!

 

[Mr Molio]

If you have one customer number such as 12345, simply use
edit>replace>12345 with xxxxx. If more use a looping macro. If ANY
number, that is different

Thanks, Don. In this case, the number format isn't standardized to use
a replace.

 

[Rick Rothstein]

That works great!! Thanks!

Here is shorter UDF which will function the same as the one James posted...

Function IDKiller(ByVal S As String) As String
Dim X As Long
For X = 1 To Len(S)
If Mid(S, X, 10) Like "##########" Then
Mid(S, X) = "XXXXXXXXXX"
Exit For
End If
Next
IDKiller = S
End Function

Rick Rothstein (MVP - Excel)

 

[Mr Molio]

Here is shorter UDF which will function the same as the one James posted....

Function IDKiller(ByVal S As String) As String
    Dim X As Long
    For X = 1 To Len(S)
        If Mid(S, X, 10) Like "##########" Then
            Mid(S, X) = "XXXXXXXXXX"
            Exit For
        End If
    Next
    IDKiller = S
End Function

Rick Rothstein (MVP - Excel)

Thanks, Rick!

Now, a new wrinkle (most likely in my brain!) - When I was originally
testing this, I had a dummy workbook open in which I added a module,
pasted in the function code, etc. I wrote a loop function to run down
the column, use this function to mask the account numbers, and then
paste the result (as a value) over the original cell. All worked
great.

I would like this function and macro to be available for new sheets,
of the same layout, since we generate these sheets every week. We took
the original file (with the module) and did as Save As to create a new
week's file. Closed Excel. I reopened Excel, opened the NEW file, and
ran the macro. Worked fine, except that, in the background, it also
opened the original file as well.

For the life of me I can't find anything in the code that references
the original file, or any file structure location. Is there somewhere
OTHER than the module code that could be telling it that the code was
originally written in ANOTHER file, and needs to open that file?

Here is the code in my module (MY bits are very un-elegant, so I'm
open to suggestions on that as well, but right now I'm just trying to
figure out what's opening that original file)


=========BEGIN CODE=============

Function IDKiller(s As String) As String
Dim L As Long, i As Long
Dim J As Long, JJ As Long
L = Len(s)
ReDim ary(1 To L)
For i = 1 To L
ary(i) = Mid(s, i, 1)
Next
kount = 0
J = 0
JJ = 0
For i = 1 To L
If ary(i) Like "#" Then
kount = kount + 1
If J = 0 Then J = i
JJ = i
If kount = 12 Then Exit For
Else
kount = 0
J = 0
JJ = 0
End If
Next
If kount = 12 Then
For jjj = J To JJ
ary(jjj) = "x"
Next
End If
IDKiller = ""
For i = 1 To L
IDKiller = IDKiller & ary(i)
Next
End Function


Sub InsertIDKILLER()
'code to insert the function, then copy the results and paste as
VALUE over the original cell

ActiveCell.FormulaR1C1 = "=idkiller(RC[-5])" 'the function is
going in a blank cell 5 columns over from the content cell
ActiveCell.Offset(-1, 0).Select 'when it
runs, it drops down to the next row, so I'm taking it back up to copy
the results
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.WrapText = True

ActiveCell.Offset(1, 0).Range("A1").Select 'this section
takes the value-copied results and replaces the original content cell
with them, then deletes the "working" cell
Selection.Copy
ActiveCell.Offset(0, -5).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 5).Range("A1").Select
Application.CutCopyMode = False
Selection.ClearContents

End Sub


Sub RunThatThing()
'loop code

Do Until IsEmpty(ActiveCell.Offset(0, -5))
InsertIDKILLER
ActiveCell.Offset(1, 0).Select
Loop
End Sub

=====END CODE=====

Thanks for everyone's help with this!

 

[Gord Dibben]

Cut all the macros and UDF's from the workbook(s) and paste them into
a module in a new workbook.

Save that workbook as an Add-in. Keep the Add-in loaded so's code
will be available for all open workbooks.

OR......................

Save the code in your Personal Macro Workbook.


Gord

Here is shorter UDF which will function the same as the one James posted...

Function IDKiller(ByVal S As String) As String
    Dim X As Long
    For X = 1 To Len(S)
        If Mid(S, X, 10) Like "##########" Then
            Mid(S, X) = "XXXXXXXXXX"
            Exit For
        End If
    Next
    IDKiller = S
End Function

Rick Rothstein (MVP - Excel)

Thanks, Rick!

Now, a new wrinkle (most likely in my brain!) - When I was originally
testing this, I had a dummy workbook open in which I added a module,
pasted in the function code, etc. I wrote a loop function to run down
the column, use this function to mask the account numbers, and then
paste the result (as a value) over the original cell. All worked
great.

I would like this function and macro to be available for new sheets,
of the same layout, since we generate these sheets every week. We took
the original file (with the module) and did as Save As to create a new
week's file. Closed Excel. I reopened Excel, opened the NEW file, and
ran the macro. Worked fine, except that, in the background, it also
opened the original file as well.

For the life of me I can't find anything in the code that references
the original file, or any file structure location. Is there somewhere
OTHER than the module code that could be telling it that the code was
originally written in ANOTHER file, and needs to open that file?

Here is the code in my module (MY bits are very un-elegant, so I'm
open to suggestions on that as well, but right now I'm just trying to
figure out what's opening that original file)


=========BEGIN CODE=============

Function IDKiller(s As String) As String
Dim L As Long, i As Long
Dim J As Long, JJ As Long
L = Len(s)
ReDim ary(1 To L)
For i = 1 To L
ary(i) = Mid(s, i, 1)
Next
kount = 0
J = 0
JJ = 0
For i = 1 To L
If ary(i) Like "#" Then
kount = kount + 1
If J = 0 Then J = i
JJ = i
If kount = 12 Then Exit For
Else
kount = 0
J = 0
JJ = 0
End If
Next
If kount = 12 Then
For jjj = J To JJ
ary(jjj) = "x"
Next
End If
IDKiller = ""
For i = 1 To L
IDKiller = IDKiller & ary(i)
Next
End Function


Sub InsertIDKILLER()
'code to insert the function, then copy the results and paste as
VALUE over the original cell

ActiveCell.FormulaR1C1 = "=idkiller(RC[-5])" 'the function is
going in a blank cell 5 columns over from the content cell
ActiveCell.Offset(-1, 0).Select 'when it
runs, it drops down to the next row, so I'm taking it back up to copy
the results
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.WrapText = True

ActiveCell.Offset(1, 0).Range("A1").Select 'this section
takes the value-copied results and replaces the original content cell
with them, then deletes the "working" cell
Selection.Copy
ActiveCell.Offset(0, -5).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 5).Range("A1").Select
Application.CutCopyMode = False
Selection.ClearContents

End Sub


Sub RunThatThing()
'loop code

Do Until IsEmpty(ActiveCell.Offset(0, -5))
InsertIDKILLER
ActiveCell.Offset(1, 0).Select
Loop
End Sub

=====END CODE=====

Thanks for everyone's help with this!

 

[Mr Molio]

Cut all the macros and UDF's from the workbook(s) and paste them into
a module in a new workbook.

Save that workbook as an Add-in.  Keep the Add-in loaded so's code
will be available for all open workbooks.

OR......................

Save the code in your Personal Macro Workbook.

Gord

Thanks, Rick!

Now, a new wrinkle (most likely in my brain!) - When I was originally
testing this, I had a dummy workbook open in which I added a module,
pasted in the function code, etc. I wrote a loop function to run down
the column, use this function to mask the account numbers, and then
paste the result (as a value) over the original cell. All worked
great.

I would like this function and macro to be available for new sheets,
of the same layout, since we generate these sheets every week. We took
the original file (with the module) and did as Save As to create a new
week's file. Closed Excel. I reopened Excel, opened the NEW file, and
ran the macro. Worked fine, except that, in the background, it also
opened the original file as well.

For the life of me I can't find anything in the code that references
the original file, or any file structure location. Is there somewhere
OTHER than the module code that could be telling it that the code was
originally written in ANOTHER file, and needs to open that file?

Here is the code in my module (MY bits are very un-elegant, so I'm
open to suggestions on that as well, but right now I'm just trying to
figure out what's opening that original file)

=========BEGIN CODE=============

Function IDKiller(s As String) As String
Dim L As Long, i As Long
Dim J As Long, JJ As Long
L = Len(s)
ReDim ary(1 To L)
For i = 1 To L
   ary(i) = Mid(s, i, 1)
Next
kount = 0
J = 0
JJ = 0
For i = 1 To L
   If ary(i) Like "#" Then
       kount = kount + 1
       If J = 0 Then J = i
       JJ = i
       If kount = 12 Then Exit For
   Else
       kount = 0
       J = 0
       JJ = 0
   End If
Next
If kount = 12 Then
   For jjj = J To JJ
       ary(jjj) = "x"
   Next
End If
IDKiller = ""
For i = 1 To L
   IDKiller = IDKiller & ary(i)
Next
End Function

Sub InsertIDKILLER()
  'code to insert the function, then copy the results and paste as
VALUE over the original cell

   ActiveCell.FormulaR1C1 = "=idkiller(RC[-5])"    'the function is
going in a blank cell 5 columns over from the content cell
   ActiveCell.Offset(-1, 0).Select                          'when it
runs, it drops down to the next row, so I'm taking it back up to copy
the results
   Selection.Copy
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
       :=False, Transpose:=False
   Selection.WrapText = True

   ActiveCell.Offset(1, 0).Range("A1").Select        'this section
takes the value-copied results and replaces the original content cell
with them, then deletes the "working" cell
   Selection.Copy
   ActiveCell.Offset(0, -5).Range("A1").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
       :=False, Transpose:=False
   ActiveCell.Offset(0, 5).Range("A1").Select
   Application.CutCopyMode = False
   Selection.ClearContents

End Sub

Sub RunThatThing()
 'loop code

   Do Until IsEmpty(ActiveCell.Offset(0, -5))
       InsertIDKILLER
       ActiveCell.Offset(1, 0).Select
   Loop
End Sub

=====END CODE=====

Thanks for everyone's help with this!

Gord,

Thanks, I'll try the Add In route. I tried the PMW but it didn't seem
to change the behaviour. Still very likely USER error, but I'm
learning by tracking it down!