Carriage Return Quote Delete Macro

[binar]

Fellow Forum Members,
The script below deletes all of the unwanted quotes that appear when Excel text strings with embedded "(Char10) carriage returns" is pasted into NotePad++.

Currently, this script only copies a single cell of data to the clipboard at a time. I need help modifying this VBA script so that I'm able to select many rows in the K Column and have all the rows I select go to the clipboard once I run the script. And then when I paste the data to NotePad++ no unwanted quotes appear. Any help will be greatly appreciated. Thanks.


Sub testme()
Dim MyDataObj As DataObject
Set MyDataObj = New DataObject
MyDataObj.SetText ActiveCell.Text
MyDataObj.PutInClipboard
End Sub




Below is my Excel formula for adding carriage returns within Excel 2007. It takes a row of concatenated data and converts it to three lines of text.



=CONCATENATE(A22,B22,C22,CHAR(10),D22,E22,F22,CHAR(10),G22,H22,I22,CHAR(10) )

[binar]

I would really be grateful if someone out there can help me modify this script so that it's able to copy a range of rows and not just a single cell. Many thanks.

[Kenneth Hobs]

Maybe this will help.
Sub t()
Dim rc As Variant
Dim s As String, s2 As String

s = ActiveWorkbook.Path & "\Hello World.txt"
s2 = "Hello World!" & vbCrLf & "Great day in the morning."
[A1] = "By"
[B1] = "Kenneth"
[C1] = "Hobson"
[A2] = "Notepad"
[B2] = "Entry"
Range("A1:C2").Copy
s2 = s2 & vbCrLf & vbCrLf & Replace(getClipboard(), vbTab, " ")

MakeTXTFile s, s2

rc = Shell("notepad " & s, 1)
Kill s
End Sub

Sub MakeTXTFile(filePath As String, str As String)
Dim hFile As Integer
If Dir(FolderPart(filePath), vbDirectory) = "" Then
MsgBox filePath, vbCritical, "Missing Folder"
Exit Sub
End If

hFile = FreeFile
Open filePath For Output As #hFile
If str <> "" Then Print #hFile, str
Close hFile
End Sub

Function FolderPart(sPath As String) As String
FolderPart = Left(sPath, InStrRev(sPath, "\"))
End Function


Function getClipboard()
'Add Reference: 'Reference: Microsoft Forms xx Object
Dim MyData As DataObject

On Error Resume Next
Set MyData = New DataObject
MyData.GetFromClipboard
getClipboard = MyData.GetText
End Function

[binar]

Kenneth,
Thanks for the post. I tried out your code and it does not perform the task I need. A text file appears declaring "Hello World", and it is something I can't use. I'll try explaining it a different way. The code below works perfectly:


Sub testme()
Dim MyDataObj As DataObject
Set MyDataObj = New DataObject
MyDataObj.SetText ActiveCell.Text
MyDataObj.PutInClipboard
End Sub


The only problem with it is that it does not copy a range of cells (i.e. K1 thru K20). It is only able to copy the data from a single cell such as K1. What I need added to the code above is some code that will enable it to copy a range of cells.

If you can do that I would be very grateful.
Each cell within the cell range of K1 thru K20 contains three text strings that look like this:



PART # 30022
Part Description goes in this line
Manufacturer info goes in this line


I'm getting three lines of text within each cell by using the Char(10) carraige return code within my concatenate function:


=CONCATENATE(A22,B22,C22,CHAR(10),D22,E22,F22,CHAR(10),G22,H22,I22,CHAR(10) )


The Char(10) works great within Excel. But once you copy a single cell containing three text strings and paste it to NotePad++ or NotePad, the CHAR(10) carriage returns convert to quotes. I want the quotes deleted and the Macro above does a great job of deleting the quotes before it puts it into the clipboard. But as I mentioned it only works on a single cell selection basis. I need the macro modified so it can handle copying from a selected cell range. If you can make this modification to the macro, I would be very grateful. Many Thanks.

[Kenneth Hobs]

If you post an example xls, we can see what is going on. Sometimes, text file writing method add quotes where other methods would not.

[binar]

If you post an example xls, we can see what is going on. Sometimes, text file writing method add quotes where other methods would not.


Kenneth,
Thanks for the help. Attached is a zip containing an Excel 2007 file with the macro as it works right now. I would be very grateful if you can modify the code so that it copies a selected cell range. Thanks.

[binar]

Kenneth,

I took a stab at modifying the macro myself but I get a compile error message when I run it. Below is my modified macro:


Sub Quote_Delete()
Columns("K:K").Select
Dim MyDataObj As DataObject
Set MyDataObj = New DataObject
MyDataObj.SetText ActiveCell.Column.Text
MyDataObj.PutInClipboard
End Sub


I added the code "Columns("K:K").Select" because I want the entire K column to be selected. I also added the code "ActiveCell.Column" because I want all of the data in the K column to be put into the clipboard (without quotes).

Any help will be appreciated. Thanks.

[Kenneth Hobs]

I looked at your file last night. Are you just wanting the copy to clipboard or can this be as I did where it opens notepad++ and the text is there already from a known range to copy from?

The range selection will also be a factor. Will it be a column selection, a matrix selection (rows+columns), or discontinuous selection.

For one column with selected cells, your code would be:
Sub testme()
Dim MyDataObj As DataObject
Dim a() As Variant, i As Integer
Set MyDataObj = New DataObject
a() = WorksheetFunction.Transpose(Selection.Value)
For i = LBound(a) To UBound(a)
a(i) = Replace(a(i), vbLf, " ")
Next i
MyDataObj.SetText Join(a(), vbCrLf)
MyDataObj.PutInClipboard
End Sub

[Kenneth Hobs]

I don't know that I would do a whole column. A million lines in a file might be large.

Use xlDown if your data is continuous. If not, we can show you how to use xlUp.

Sub testme()
Dim MyDataObj As DataObject
Dim a() As Variant, i As Integer, r As Range
Set MyDataObj = New DataObject
Set r = Range("A1", Range("A1").End(xlDown))
a() = WorksheetFunction.Transpose(r)
For i = LBound(a) To UBound(a)
a(i) = Replace(a(i), vbLf, " ")
Next i
MyDataObj.SetText Join(a(), vbCrLf)
MyDataObj.PutInClipboard
End Sub

[binar]

Hi Kenneth,
Thank you very much for your time and posting both variations of your modified code. I tried both of them and there seems to be a problem with both of them. The first one you posted does a great job of deleting the unwanted quotes. However, the three line text string structure has disappeared. When I paste the clipboard content to NotePad++ all I see is a single continuous line of text. It would be perfect if your code duplicated the original code in this respect.

The second code you posted seems to only contain in the clipboard the first part of the concatenation (only A1 data). All of the rest of the data (B1 thru I1) seems to be missing. Below is the function I'm using to concatenate the text strings and add a carriage return.


=CONCATENATE(A1,B1,C1,CHAR(10),D1,E1,F1,CHAR(10),G1,H1,I1,CHAR(10))


To answer your question I need the data sent to the clipboard and not straight to NotePad like your first code posting does. Also, I am okay with selecting the range of cells I want to copy. I don't need a million cell copy range.

Lastly, the stab I took at coding it myself seems to have turned out to be a total joke. The two lines of code I added were not anywhere near the ball park (commpared to what you have posted). I guess this proves I can't code anything to save my life.

Thanks again for your help. :hi:

[Kenneth Hobs]

I am not sure why that last code was a problem for you. It worked fine for me. As for the part about the single line, I thought that was what you wanted. If not, just delete the loop. I commented it out here. If you don't want a blank line between the entries, change the Join string vbCrLf to "" or whatever you like.

Sub testme()
Dim MyDataObj As DataObject
Dim a() As Variant, i As Integer, r As Range
Set MyDataObj = New DataObject
Set r = Range("A1", Range("A1").End(xlDown))
a() = WorksheetFunction.Transpose(r)
'For i = LBound(a) To UBound(a)
' a(i) = Replace(a(i), vbLf, " ")
'Next i
MyDataObj.SetText Join(a(), vbCrLf)
MyDataObj.PutInClipboard
End Sub

Sub testme1()
Dim MyDataObj As DataObject
Dim a() As Variant, i As Integer
Set MyDataObj = New DataObject
a() = WorksheetFunction.Transpose(Selection.Value)
'For i = LBound(a) To UBound(a)
' a(i) = Replace(a(i), vbLf, " ")
'Next i
MyDataObj.SetText Join(a(), vbCrLf)
MyDataObj.PutInClipboard
End Sub

[binar]

Kenneth,
You are the Man ! :thumb The bottom code works perfectly. What you did as far as commenting out the loop took care of the problem. The top one still has the same problem. Nevertheless, I'm happy with the bottom one just as well. It does the task I need which is it deletes all the unwanted quotes and it gives me the three lines of text per concatenated row. I am amazed how much trouble those darn quotes posed. Something so minor really put up a good fight. I have been messing with this for over a week now. Again thanks a lot for your help. This is like the third time you get me out of a jam. You are the best member of this forum.

[Kenneth Hobs]

Flowers are always nice. I am just a shade-tree programmer so once-in-a-while I get lucky.

For discontinuous selections, you will need another approach.

For the xlEndUp method:
Sub testme2()
Dim MyDataObj As DataObject
Dim a() As Variant, i As Integer, r As Range
Set MyDataObj = New DataObject
Set r = Range("A1", Range("A" & Cells.Rows.Count).End(xlUp))
a() = WorksheetFunction.Transpose(r)
MyDataObj.SetText Join(a(), vbCrLf)
MyDataObj.PutInClipboard
End Sub