I am using the below code to copy a specific range of data and paste the results into a txt file. However, when pasting additional quotes are being generated on the longer lines that are automatically wrapping to a new line. Is there a way to paste the range into the text file and ensure each cell is on one line only, and there are no additional quotes ?
Example of current output with line breaks that are not present in excel, data is in one cell that does not wrap:
"Account number|test account|{""TT"":3,""True"",""Dept"",""SubDept"",""Street""|test1"
Desired output on one line in txt file:
Account number|test account|{"TT":3,"True","Dept","SubDept","Street"|test1
sub Test()
Application.ScreenUpdating = False
Dim formulasheet As Worksheet
Dim copysheet As Worksheet
Dim num As Integer
Dim valuecolumn As Range, cell As Object
Dim copycolumn As Range
Dim i As Range
num = 0
Set formulasheet = ActiveWorkbook.Sheets("Upload Template")
Set copysheet = ActiveWorkbook.Sheets("Copy")
Set valuecolumn = formulasheet.Range("B:B")
Set copycolumn = formulasheet.Range("A:A")
copysheet.Cells.Clear
formulasheet.Select
For Each i In valuecolumn
If i.Value > 0 Then
i.Offset(0, -1).Copy
copysheet.Select
copysheet.Range("A1").End(xlUp).Offset(num, 0).PasteSpecial Paste:=xlPasteValues
num = num 1
End If
Next i
If copysheet.Range("A1") = "" Then
MsgBox "No transaction amounts, please review."
Exit Sub
Else
copysheet.Select
copysheet.Range("A:A").Copy
End If
Shell "notepad.exe", vbNormalFocus
SendKeys "{NUMLOCK}^v
end sub
CodePudding user response:
In this example I use Transpose
to convert the column values into a 1D array which is then joined and copied to the clipboard.
Sub Test()
Dim ClipBoard As Object
Set ClipBoard = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Dim Result As String
Result = UploadTemplateFormulaText
If Len(Result) = 0 Then
MsgBox "No transaction amounts, please review."
Else
ClipBoard.SetText Result
ClipBoard.PutInClipboard
Shell "notepad.exe", vbNormalFocus
SendKeys "{NUMLOCK}^v"
End If
End Sub
Function UploadTemplateFormulaText() As String
Dim Target As Range
With wsUploadTemplate
Set Target = .Range("B1", .Cells(.Rows.Count, "B").End(xlUp))
End With
If Target.Rows.Count = 1 Then
If Len(Target.Value) = 0 Then Exit Function
UploadTemplateFormulaText = Target.Value
Else
Dim Data As Variant
Data = WorksheetFunction.Transpose(Target.Value)
UploadTemplateFormulaText = Join(Data, vbNewLine)
End If
End Function
Function wsUploadTemplate() As Worksheet
Set wsUploadTemplate = ThisWorkbook.Worksheets("Upload Template")
End Function
It is very easy to write to a text file. I recommend using a FileScriptingObject (PC Only) see: VBA CreateTextFile
CodePudding user response:
Please, try the next way. Use your existing code up to copying and then the next way to place the content in a text file:
Sub copyColumnToNotepad()
Dim sh As Worksheet, lastR As Long, arr, copyPath As String, i As Long, strText
Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
arr = sh.Range("A1:A" & lastR).value 'place the range in an array for faster iteration
For i = 1 To UBound(arr) 'create the necessary string to pe placed in the text file
strText = strText & arr(i, 1) & vbCrLf
Next i
copyPath = ThisWorkbook.Path & "\TestText.txt" 'the path of the text file to be created
Open copyPath For Output As #1
Print #1, strText 'place the string in the text file
Close #1
'Open the file in Notepad:
Shell "Notepad.exe " & copyPath, vbNormalFocus
End Sub
SendKeys
is not a reliable way to copy anything...