VBA: On clipboard: Replace all non alphanumeric characters for * and copy them to the clipboard

[MrNotepad]

Hi,

I need to do the following and I'd really thank you guys if you could give me a friendly hand with it:


From a selected range, copy and replace all non alphanumeric characters and spaces for * so that I have the result on the clipboard ready to be pasted somewhere. At the beginning and at the end of the text it should put a * also.

ie: Cell A1 has Roller#13$10 "Klein"
When I select cell A1 and run the Macro it will prepare the following on the clipboard to be pasted
somewhere. *Roller*13*10**Klein*
Cell A1 will keep its original text. It should do everything in the background and have the copied result
in the clipboard.

Best to you all,
Camilo

 

[snb_]

Since I had no idea how to add chr(9), chr(10) & chr(13) to the 'Like' pattern, I made a workaround that seems to be too complicated.

I revised it into:

Sub M_snb_008()
  Selection.Copy
  
  With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .getfromclipboard
        c00 = .gettext
        
        For j = 1 To Len(c00)
           If Mid(c00, j, 1) Like "[!a-z0-9]" And InStr("|9|10|13|", "|" & Asc(Mid(c00, j, 1)) & "|") = 0 Then Mid(c00, j, 1) = "*"
        Next
        
        .Clear
        .SetText c00
        .PutInClipboard
  End With

  Sheet1.Paste Sheet1.Cells(20, 1)
End Sub

 

[pgc01]

Hi

I believe you can add those characters directly to the pattern:

       If Mid(c00, j, 1) Like "[!a-z0-9" & vbTab & vbCrLf & "]" Then Mid(c00, j, 1) = "*"

 

[snb_]

@pgc01

Thank you !

Resulting in:

Sub M_snb()
  Selection.Copy
  
  With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .getfromclipboard
        c00 = .gettext
        
        For j = 1 To Len(c00)
'  or          If Mid(c00, j, 1) Like "[!a-z0-9" & Chr(9) & Chr(10) & Chr(13) & "]" Then Mid(c00, j, 1) = "*"
        
'  or          If Mid(c00, j, 1) Like "[!a-z0-9" & vbTab & vbLf & vbCr & "]" Then Mid(c00, j, 1) = "*"
        Next
        
        .Clear
        .SetText c00
        .PutInClipboard
  End With
  
  Sheet1.Paste Sheet1.Cells(20, 1)
End Sub