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

 

[shg]

Minimally tested:

Sub MNP()
    Dim s           As String
    Dim oDO         As Object
    Dim i           As Long

    s = ActiveWindow.RangeSelection.Cells(1).Text
    Set oDO = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    For i = 1 To Len(s)
        Select Case Mid(s, i, 1)
            Case "0" To "9", "A" To "Z", "a" To "z"
            Case Else
                Mid(s, i) = "*"
        End Select
    Next i

    oDO.SetText "*" & s & "*"
    oDO.PutInClipboard
    Beep
End Sub

 

[BiocideJ]

I believe this code will do what you are requesting.

Sub A1_to_ClpBoard()
Dim strInitial As String, strFinal As String
Dim c As Long
Dim objData As New MSForms.DataObject
    
    strInitial = Range("A1").Value
    
    For c = 1 To Len(strInitial)
        Select Case Asc(Mid(strInitial, c, 1))
        Case 97 To 122  'a-z
            strFinal = strFinal & Mid(strInitial, c, 1)
        Case 65 To 90   'A-Z
            strFinal = strFinal & Mid(strInitial, c, 1)
        Case 48 To 57   '0-9
            strFinal = strFinal & Mid(strInitial, c, 1)
        Case Else
            
            strFinal = strFinal & "*"
        End Select
    Next c
    
    objData.SetText strFinal
    
    objData.PutInClipboard
    Set objData = Nothing
End Sub

 

[BiocideJ]

Wow, talk about similar code. The one thing I did forget to mention is that my code requires a reference to the Microsoft Forms 2.0 Object Library to be added.
Since shg uses late binding, I don't believe his will need the reference.

BTW, how did you come up with CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") as being a Form object?

 

[shg]

BTW, how did you come up with CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") as being a Form object?

Probably from Rory or Colin.

 

[MrNotepad]

Thank you guys. You are very helpful. Just one small thing in shg's code, which I found a little simplier for my understanding level:

It works only for the first selection in the cells range. Is there any way to make it work for a larger selection range, if possible, can you also make it so that it changes lowercase for uppercase.

God bless

 

[pgc01]

BTW, how did you come up with CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") as being a Form object?

Hi

Remark: you can find the CLSID in the Registry. Look for "Microsoft Forms 2.1 DataObject"

 

[BiocideJ]

From shg's code, replacing

s = ActiveWindow.RangeSelection.Cells(1).Text

with

s = UCase(ActiveWindow.RangeSelection.Cells(1).Text)

will result in an all upper-case string in the clipboard.


I am confused by this question though...

It works only for the first selection in the cells range. Is there any way to make it work for a larger selection range

I thought you only wanted cell A1...
If you want multiple cells, how do you plan on using them as I doubt you want them all put into the clipboard at the same time.

EDIT: OK, I just re-read the OP and realize I understood you incorrectly. How exactly do you want to handle multiple cells selected?
i.e.
A1 = "this&go"
A2 = "-or123"

what should be the expected output if A1&A2 are selected?

 

[Rick Rothstein]

Minimally tested:

Sub MNP()
    Dim s           As String
    Dim oDO         As Object
    Dim i           As Long

    s = ActiveWindow.RangeSelection.Cells(1).Text
    Set oDO = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    For i = 1 To Len(s)
[COLOR=#ff0000][B]        Select Case Mid(s, i, 1)
            Case "0" To "9", "A" To "Z", "a" To "z"
            Case Else
                Mid(s, i) = "*"
        End Select
[/B][/COLOR]    Next i

    oDO.SetText "*" & s & "*"
    oDO.PutInClipboard
    Beep
End Sub

The part of your code that I highlighted in red can be replaced by this single line of code...

If Mid(s, i, 1) Like "[!A-Za-z0-9]" Then Mid(s, i) = "*"

 

[MrNotepad]

Thank you all again. Tried Rick's replacement suggestion but got the same result. Having those two strings in A1 and A2 I would like to select both, run the macro and be able to paste the following somemwhere:

**this*go**

***or123** As of right now, I select both cells. run the macro and I'm able to paste only **this*go** I never imagined I was going to get such good responses so quickly. Cant thank you all enough <tbody> </tbody>

<colgroup><col style="width: 48pt;" width="64">
<tbody>


</tbody>