Is there a way to get the contents of a text file and add it to the clip board?
I am thinking along the lines of setting the contents of the DataObject as the contents from a file and then adding the DataObject to the clipboard.
Is this something you can do from Excel VBA?
This is the Code I am using to get the data into a txt file in the correct format. However, I also require it in the clipboard so I can just paste it.
With ws2
Open "C:\Users\peter.carr\Documents\New Action Plan\copytest.txt" For Append As #1
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = lastrow To 2 Step -1
str1 = ""
Print #1, ws2.Cells(i, 1).Value & ") " & ws2.Cells(i, 2).Value
Print #1,
For Each cell In .Range(.Cells(i, 6), .Cells(i, lastcol))
g = i - 1
If cell.Column <> 4 And cell.Column <> 5 And cell.Value <> "" And cell.Value <> "NEW ACTION" Then
Print #1, cell.Value
Print #1, "(" & cell.Offset(-g, 0).Value & ")"
Print #1,
End If
Next cell
Next i
Close #1
End With
I know I could just open the file and copy it. However, the idea is that this is part of a larger process to automate things, hence I really want to be able to fo this without opening the file.
Sub TextToClipboard()
Dim sFile As String: sFile = "C:\Test.txt"
Dim sText As String
Dim Dataobj As DataObject
Set Dataobj = New DataObject
Open sFile For Input As #1
sText = Input(LOF(1), 1)
Dataobj.SetText sText
Dataobj.PutInClipboard
End Sub
Related
I have a master workbook with one sheet that I need to be broken into many workbooks that each have a single worksheet.
These newly created workbooks will be created when rows in the "Master" worksheet have the same content in column B.
I need these workbooks to be saved to the same specific local directory with the file name being the content of column B & ".csv" to make the file a CSV file rather than an XLSX file.
Here is what I have so far (a lot of this came from another upvoted thread on this site with a few tweaks by me).
Sub Splitter()
Dim Master As Workbook
Set Master = Workbooks("Master").Worksheets("Master") 'This declares the target worksheet.
last = 1
For i = 1 To 2000 'This defines the amount of rows
If Range("B" & i) <> Range("B" & (i + 1)) Then
Range("A" & last & ":F" & i).Copy
Set NewBook = Workbooks.Add
NewBook.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
Rows(1).EntireRow.Insert Shift:=xlDown
Range("A1").Value = "Header1"
Range("B1").Value = "Header2"
Range("C1").Value = "Header3"
Range("D1").Value = "Header4"
Range("E1").Value = "Header5"
Range("F1").Value = "Header6"
last = i + 1
Master.Activate
End If
Next i
End Sub
This code will create hundreds, if not thousands, of workbooks with single worksheets from the "Master" Workbook.
I'm having a couple issues here:
This code:
Rows(1).EntireRow.Insert Shift:=xlDown
Range("A1").Value = "Header1"
Range("B1").Value = "Header2"
Range("C1").Value = "Header3"
Range("D1").Value = "Header4"
Range("E1").Value = "Header5"
Range("F1").Value = "Header6"
appears to be adding the header row correctly but it seems to be copying the entire contents of the spreadsheet and pasting it at the next available row. It then overwrites the contents of row 1.
Example: The macro pulls the following rows to a new workbook:
Bat
Bat
Bat
When the above section of code runs, the final product is:
Header
Bat
Bat
Bat
Bat
Bat
It appears to be replicating the content and then pasting over row 1.
The second issue, as alluded to earlier, is that the newly created workbooks/worksheets will not be automatically saved (CSV) and closed, and I will need to go in and close/save them each myself.
They seem to be being created correctly (with the exception of the issue in problem #1). They are simply left open and I need to name and save all of them. Since I am sure there will be a great many of the newly created workbooks, this lack of functionality will make my life very difficult ...
Any help with this would be greatly appreciated. I am fairly new to this, but am picking it up pretty quickly.
My apologies for the long post, I wanted to be as clear as I could as to not waste the readers time.
Because you are still in CopyMode from Range("A" & last & ":F" & i).Copy the .Insert will insert the copied rows again. Therefore put a Application.CutCopyMode = False right before Rows(1).EntireRow.Insert to stop inserting copied rows again.
You need Workbook.SaveAs Method and Workbook.Close Method to save and close the workbooks.
NewBook.SaveAs(FileName, FileFormat, Password, WriteResPassword, ReadOnlyRecommended, CreateBackup, AccessMode, ConflictResolution, AddToMru, TextCodepage, TextVisualLayout, Local)
NewBook.Close(SaveChanges, Filename, RouteWorkbook)
eg. This should work:
NewBook.SaveAs FileName:="C:\Temp\MyFileName.csv", FileFormat:=xlCSV
NewBook.Close SaveChanges:=False
You should specify any Rows() and Range() with a worksheet like Master.Rows() or NewBook.Worksheets("Sheet1").Range() so that is clear in which workbook\worksheet the range/row is. Then you don't need Master.Activate
What think about this code.
Sub Splitter()
Dim Master As Workbook
Dim n As Integer
Dim strFile As String
Set Master = Workbooks("Master").Worksheets("Master") 'This declares the target worksheet.
last = 1
For i = 1 To 2000 'This defines the amount of rows
If Range("B" & i) <> Range("B" & i + 1) Then
strFile = ThisWorkbook.Path & "\" & Range("b" & i) & ".csv"
TransToCSV strFile, Range("A" & last & ":F" & i)
last = i + 1
End If
Next i
End Sub
Sub TransToCSV(myfile As String, rng As Range)
Dim vDB, vR() As String, vTxt()
Dim i As Long, n As Long, j As Integer
Dim objStream
Dim strTxt As String, strHeader As String
strHeader = "Header1,Header2,Header3,Header4,Header5,Header6" & vbCrLf
Set objStream = CreateObject("ADODB.Stream")
vDB = rng
For i = 1 To UBound(vDB, 1)
n = n + 1
ReDim vR(1 To UBound(vDB, 2))
For j = 1 To UBound(vDB, 2)
vR(j) = vDB(i, j)
Next j
ReDim Preserve vTxt(1 To n)
vTxt(n) = Join(vR, ",")
Next i
strTxt = strHeader & Join(vTxt, vbCrLf)
With objStream
'.Charset = "utf-8"
.Open
.WriteText strTxt
.SaveToFile myfile, 2
.Close
End With
Set objStream = Nothing
End Sub
I'm working on a Excel sheet that gets a lot of information.
Some columns have information that i need to use in a script and i use the following code I've found to save whatever i select in a .txt file after i click a button.
Private Sub CommandButton21_Click()
Dim myFile As String, rng As Range, cellValue As Variant, i As Integer, j As Integer
myFile = Application.DefaultFilePath & "\NumeroChamados.txt"
Set rng = Selection
Open myFile For Output As #1
For i = 1 To rng.Rows.Count
For j = 1 To rng.Columns.Count
cellValue = rng.Cells(i, j).Value
If j = rng.Columns.Count Then
Write #1, cellValue
Else
Write #1, cellValue,
End If
Next j
Next i
Close #1
End Sub
Thing is everything i save ends up with quotation marks like the example below:
"4146546546523133"
"4285725763131"
"461"
"4230236646435356694197285187451644148"
"4230375763756379653464564"
The cells i select usually contain a string from another cell in which i use a macro to get it.
To avoid adding wrapping quotes to anything Excel interprets as a string (even text-that-looks-like-a-number), use Print instead of Write.
Private Sub CommandButton1_Click()
Dim myFile As String, rng As Range, cellValue As Variant, i As Integer, j As Integer
myFile = Application.DefaultFilePath & "\NumeroChamados.txt"
Set rng = Selection
Open myFile For Output As #1
For i = 1 To rng.Rows.Count
For j = 1 To rng.Columns.Count
cellValue = rng.Cells(i, j).Value
If j = rng.Columns.Count Then
Print #1, cellValue
Else
Print #1, cellValue,
End If
Next j
Next i
Close #1
End Sub
I have an excel sheet with just one worksheet. The first row of this excel sheet has the Title for the columns.
The worksheet has data in below columns and n number of rows:
Columns: A | B | C | D | E | F | G | H
First I am creating a copy of the file and renaming it - This WORKS!
'Copy and rename the file
Dim sourceFile As String, destFile As String
sourcePath = Range("D6")
destFile = Split(sourcePath, ".")(0) + "_Formated.xls"
FileCopy sourcePath, destFile
I want to read this destFile excel sheet via VBA code. I will doing some cell manipulation so please give me a working code to understand how that whole worksheet is read and how I can access a particular row while in a for loop.
I also want to know the code to add new column title and values to this destFile excel sheet via VBA code.
Whats the code for just clearing the cell value via VBA code and not delete the cell.
I want to read this destFile excel sheet via VBA code. I will doing some cell manipulation so please give me a working code to understand how that whole worksheet is read and how I can access a particular row while in a for loop.
dim sh as Worksheet
set sh = Workbooks.Open(destFile).Worksheets(1)
I also want to know the code to add new column title and values to this destFile excel sheet via VBA code.
sh.rows(1).Insert Shift := xlDown
ThisWorkbook.Worksheets(1).Rows(1).Copy sh.Rows(1)
Whats the code for just clearing the cell value via VBA code and not delete the cell.
sh.Range("A1").Value = ""
I managed to get this done with the below code.
This is the worst way to code it and does not look anything sophisticated but it gets the job done.
Thanks!
Sub Format()
'Copy and rename the file
Dim SourceFile As String, DestFile As String
SourceFile = Range("D6")
SourceString = Range("D3")
TestSuiteName = Range("D2") & "\"
DestFile = Split(SourceFile, ".")(0) + "_Formated.xls"
On Error GoTo ErrorHandler:
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.FileExists(DestFile) Then
FileCopy SourceFile, DestFile
End If
'Read DestFile worksheet content
Dim wks As Worksheet
Set wks = Workbooks.Open(DestFile).Worksheets(1)
Dim rowRange As Range
Dim colRange As Range
Dim LastCol As Long
Dim LastRow As Long
LastRow = wks.Cells(wks.rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 6).Value = "Step 1" Then
Cells(i, 7) = "Other_Migration_Fields" & Cells(i, 7) & vbLf & vbLf & "QC Path:" & Cells(i, 8)
Cells(i, 8) = Replace(Cells(i, 8), SourceString, TestSuiteName)
Else
Cells(i, 1) = ""
Cells(i, 2) = ""
Cells(i, 7) = ""
Cells(i, 8) = ""
End If
Next i
ErrorHandler:
Msg = "Error # " & Str(Err.Number) & " was generated by " & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
If Err.Number <> 0 Then
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
Else
MsgBox "Success!"
End If
Exit Sub
End Sub
I am trying to write code in VBA that will copy a range of cells. This I have done successfully but got stuck on the next step. This is the first part:
Range("L1", Range("L1").End(xlDown)).Select
Selection.Copy
Next, I would like the macro to open a new text file (.txt) with the specified name from the excel tab and insert the copied cells.
How do I open a text file?
Thank you
Here is one of many possible references (via Google): http://www.homeandlearn.org/write_to_a_text_file.html
Here is the example they give - you're better reading the article and then adapting to your scenario:
Open FilePath For Output As #2
For i = 1 To LastRow
For j = 1 To LastCol
If j = LastCol Then
CellData = CellData + Trim(ActiveCell(i, j).Value)
Else
CellData = CellData + Trim(ActiveCell(i, j).Value) + ","
End If
Next j
Write #2, CellData
CellData = ""
Next i
With your column L data in the first tab, try:
Sub dural()
Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Add
wb1.Activate
Sheets(1).Select
tabname = ActiveSheet.Name
Range("L1", Range("L1").End(xlDown)).Copy
wb2.Activate
ActiveSheet.Paste
wb2.SaveAs Filename:=tabname & ".txt", FileFormat:=xlTextWindows
wb2.Saved = True
wb2.Close
End Sub
I am relatively new to VBA.
I have a target workbook where the first step is somebody has to write something. If not an error message pops up.
After they filled in their data the code will ask them to open the source workbook(they downloaded the file before). From the source workbook certain columns are read. This all works fine in the code. The problem I have is to get what they filled in the target workbook to be copied down in column (A4:A(last row in source workbook). So the length until where their manually entered data has to be copied down has to be equal to the length of data in the source workbook.
Sub get_rate_codes()
Dim CheckCell As Range
Dim wb_source As Workbook
Dim wb_target As Workbook
Dim strPathName As String
Dim lastRow As Long
For Each CheckCell In Sheets("rate_codes").Range("F3").Cells
If Len(Trim(CheckCell.Value)) = 0 Then
CheckCell.Select
MsgBox "Cell " & CheckCell.Address(0, 0) & " is empty. Please enter SITA."
Exit Sub
End If
Next CheckCell
'start to open file
Application.ScreenUpdating = False
'start is the starting cell while lastRow measures the last data row in the external file
Start = 4
'continue to copy data from the rate codes report
Set wb_target = ActiveWorkbook
With wb_target.Sheets("rate_codes")
lastRow = wb_source.UsedRange.SpecialCells(xlCellTypeLastCell).Row
strPathName = Application.GetOpenFilename()
If strPathName = "False" Then
Exit Sub
End If
Set wb_source = Workbooks.Open(strPathName, 0)
.Range("B" & Start & ":B1000").Value = wb_source.Sheets(1).Range("E2:E1000").Value
.Range("C" & Start & ":C1000").Value = wb_source.Sheets(1).Range("H2:H1000").Value
.Range("D" & Start & ":D1000").Value = wb_source.Sheets(1).Range("G2:G1000").Value
.Range("E" & Start & ":E1000").Value = wb_source.Sheets(1).Range("K2:K1000").Value
.Range("A" & Start & ":A" & lastRow).Value = wb_target.Sheets(2).Range("F2").Value '
wb_source.Close (False)
End With
'close file without saving
Application.ScreenUpdating = True
End Sub
To find the last row you can do this.
Dim lastRow As Long
lastRow = wb_source.Cells(wb_source.Rows.count, "A").End(xlUp).Row
Then you can write to the next line.
.Range("A" & lastRow + 1).Value =