I have an excel file that looks like this:
3001 T81 90300010 001
3001 T81 90300011 001
and the issue is that some of the numbers are numbers stored as txt.
Also there are strings: "T81"
I need the outputted txt file to look like this:
3001T8190300010001
No Spaces, quotes, etc.
I was able to run this script to do most of the legwork:
Dim myFile As String, rng As Range, cellValue As Variant, I As Integer, j As Integer
myFile = Application.DefaultFilePath & "\test_data_output.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
Now its output is not quite perfect:
3001,"T81",90300010,"001"
3001,"T81","90300011","001"
In the line where you set cellValue, just keep adding the strings together (converting value to strings):
cellValue = cellValue + Cstr(rng.Cells(I, j).Value)
Then between your next j and next I, reset cellValue:
Next j
cellValue = ""
Next I
Dim v as Variant
v = rng.Value
For i = LBound(v,1) to UBound(v,1)
Write #1, Replace(Replace(Join(WorksheetFunction.Index(v,i,0),""),",","")," ","")
Next
Related
I am working on a tablesheet, using VBA for a unique macro function.
This macro functions allows me to export the values from selected cells in the tablesheet to any folder in my computer.
Dim myFile As String, rng As Range, cellValue As Variant, i As Integer, j As Integer
myFile = "C:\Users\caique.fernandes\Desktop\" & "\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).Value2
If j = rng.Columns.Count Then
Write #1, cellValue
Else
Write #1, cellValue,
End If
Next j
Next i
Close #1
End Sub
There's a column that the values are like 000001, 000002, etc. When I select it to export the values on a .txt file, it exports the values like "000001" but I need only the numbers. I have already tried put single quotes at the beginning of the cell, change the code for Print intead of Write and also changed the cell type for text/number/general, but it continues to exporting the value with quotation marks.
Does anyone know how to solve this?
Ps. All others columns that I have with numbers are prices and dates, and the format for this one have to be like 000001.
If you need more control over how certain columns are output then you can do something like this:
Sub Tester()
Dim myFile As String, rng As Range, i As Long, j As Long
Dim qt As String, lf As String, sep As String, ln As String
myFile = "C:\Tester\NumeroChamados.txt"
Set rng = Selection
Open myFile For Output As #1
For i = 1 To rng.Rows.Count
ln = ""
sep = ""
For j = 1 To rng.Columns.Count
qt = IIf(j = 1 And i > 1, """", "") 'adding quotes? e.g. Col1 only
lf = IIf(j = rng.Columns.Count, vbCrLf, "") 'end of line?
ln = ln & sep & qt & rng.Cells(i, j).Value2 & qt & lf
sep = vbTab 'add separator after first value is written
Next j
Print #1, ln
Next i
Close #1
End Sub
If you need cross-platform support then check out: vbNewline vs Chr(10) as linebreak delimiter in Windows vs. Mac OSX
I'm trying to export Excel data to individual text files. Currently, the code I've got below exports the selection in Excel to a file titled "AgreementText.txt". I'd like to do two things to improve it, but I'm not sure how:
Firstly, I want to title each .txt file something different. The titles of the files are listed in a column 4 spaces to the left of each selection. Is there any way I can grab the title each time from that column?
Secondly, the text currently appears in the text file with quotation marks around it. Is there any way I can remove those?
Edit: Thirdly, I also need to specify a different file path to the default, but I'm not sure how.
Thanks in advance!
Sub TextFileExport()
Dim myFile As String, rng As Range, cellValue As Variant, i As Integer, j As Integer
myFile = Application.DefaultFilePath & "\AgreementText.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
Firstly, the title can easily just get retrieved by getting the cell value. Assuming it will be in the same row as the top of your selection, but 4 columns to the right, you can do it as follows:
myFile = Application.DefaultFilePath & "\" & Selection.Cells(1, Selection.Columns.Count + 4) & ".txt"
Open myFile For Output As #1
Secondly, you can use Print instead of Write to print without quotes. I find the easiest is to just build the whole line you want to write as one string and then do a single Print command for each line.
Putting it all together:
Sub TextFileExport()
Dim myFile As String
Dim rng As Range
Dim line
Dim i As Integer
Dim j As Integer
Set rng = Selection
myFile = Application.DefaultFilePath & "\" & rng.Cells(1, rng.Columns.Count + 4) & ".txt"
Open myFile For Output As #1
For i = 1 To rng.Rows.Count
line = ""
For j = 1 To rng.Columns.Count
line = line & rng.Cells(i, j).Value
If j < rng.Columns.Count Then
line = line & ","
End If
Next
Print #1, line
Next
Close #1
End Sub
I am able to print the values from excel to notepad, but the format is bit different,
Dim txtFile As String, rng As Range, cellValue As Variant, r As Integer, c As Integer
txtFile = slocation & "\" & "Cont_name_" & Filename & ".txt"
lrow = Range("I" & Rows.Count).End(xlUp).Row
Range("A2:G" & lrow).Select
Set rng = Selection
Open txtFile For Output As #1
For r = 1 To rng.Rows.Count
For c = 1 To rng.Columns.Count
cellValue = rng.Cells(r, c).Value
If InStr(cellValue, "/") Then
cellValue = Format(cellValue, "yyyyMMDD")
End If
If c = rng.Columns.Count Then
Print #1, cellValue
Else
Print #1, cellValue,
End If
Next c
Next r
Close #1
Spaces are more than the requirement, please help to achieve the desired output,because the tool is accepting only the desired format
Your first output uses the standard "print zones" in every 14th column (positions 1, 15, 29, ...), which you get by printing with appended comma
.............|.............|.............|.............|.............|.............|
XXX-XX-XXXX 20190111 AA 123 NAME NAME XXXXX
Your desired output starts at the next multiple of 8 characters (1, 9, 17, ...)
.......|.......|.......|.......|.......|.......|.......|.......|.......|
XXX-XX-XXXX.....20190111........AA......123.....NAME....NAME....XXXXX
You can set the next print position in your file by Seek
Private Sub SaveAsText()
Dim rng As Range
Dim r As Long, c As Long
Set rng = ActiveSheet.Range("A1:G1")
Dim file1 As Integer
file1 = FreeFile
Open ThisWorkbook.Path & "\test.txt" For Output As file1
For r = 1 To rng.Rows.Count
For c = 1 To rng.Columns.Count
If c = 1 Then
Print #file1, CStr(rng.Cells(r, c).Value);
Else
Seek #file1, (Seek(file1) \ 8 + 1) * 8 + 1
Print #file1, CStr(rng.Cells(r, c).Value);
End If
Next c
Next r
Close #file1
End Sub
Additional Hints:
Use Freefile to get the next free file number (which might be 1).
Use CStr() to prevent the automatically added space characters before and after numeric values.
So I have one excel document that has partially filled character array ("|" shows excel column line):
Current Result ("_" is a space):
1111GGH80100022190
1112QQH80100023201
1113GGH80100045201
1114AAH80100025190
So my current code outputs this above result. The problem is that characters 1-5 and 21-24 get skipped over. In general if there is no column number accounted for I should print " " (Space).
Desired Result ("_" is a space):
_____1111GGH80100022____190
_____1112QQH80100023____201
_____1113GGH80100045____201
_____1114AAH80100025____190
Is there are column way to detect if I am missing a range in the header column? I currently use this and only select the data:
Private Sub WriteFile_Click()
Dim myFile As String, rng As Range, cellValue As Variant, I As Integer, j As Integer
myFile = "C:\Reformatted.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 = cellValue + CStr(rng.Cells(I, j).Value)
cellValue = Replace(cellValue, "NULL", " ")
If j = rng.Columns.Count Then
Print #1, cellValue
End If
Next j
cellValue = ""
Next I
Close #1
Shell "C:\Windows\Notepad.exe C:\Reformatted.txt", 1
End Sub
-----------------------------After TMh885 Answer--------------------------------
So the code works perfectly EXCEPT if you have a header thats a single number '63'
So I am trying this:
Private Sub CommandButton1_Click()
Dim myFile As String, rng As Range, cellValue As Variant, I As Integer, j As Integer
myFile = "C:\Reformatted.txt"
Set rng = Selection
Open myFile For Output As #1
Dim strArr(1 To 63) As String, intBeg As Integer, intEnd As Integer, intCount As Integer
For I = 2 To rng.Rows.Count
For j = 1 To rng.Columns.Count
If Len(Cells) = 1 Then
cellValue = cellValue + " "
Else
intBeg = Val(Left(Cells(1, j).Value, InStr(1, Cells(1, j).Value, "-") - 1))
intEnd = Val(Right(Cells(1, j).Value, Len(Cells(1, j).Value) - InStr(1, Cells(1, j).Value, "-")))
intCount = 1
For t = intBeg To intEnd
strArr(t) = Mid(Cells(I, j).Value, intCount, 1)
intCount = intCount + 1
Next t
End If
Next j
For t = 1 To UBound(strArr)
If strArr(t) = "" Then strArr(t) = " "
cellValue = cellValue + strArr(t)
Next t
Erase strArr
Print #1, cellValue
cellValue = ""
Next I
Close #1
Shell "C:\Windows\Notepad.exe C:\Reformatted.txt", 1
End Sub
--------------------------------Error Snapshot----------------------------------
Input:
Here's your code with the extra functionality built in. It essentially just builds an array, adds each character to the correct location then adds it all together, replacing blanks with spaces. You'll have to change the maximum (in this example it's hard-coded at 27) but you could use the same logic as I used to get "intEnd" to find your maximum by looping over the heading column. Notes, this will compensate for out of order columns and I assumed that the Selection includes headers (hence starting at I = 2):
Private Sub WriteFile_Click()
Dim myFile As String, rng As Range, cellValue As Variant, I As Integer, j As Integer
myFile = "C:\Reformatted.txt"
Set rng = Selection
Open myFile For Output As #1
Dim strArr(1 To 27) As String, intBeg As Integer, intEnd As Integer, intCount As Integer
For I = 2 To rng.Rows.Count
For j = 1 To rng.Columns.Count
If InStr(1, CStr(Cells(1, j).Value), "-") = 0 Then
strArr(Val(Cells(1, j).Value)) = Cells(I, j).Value
Else
intBeg = Val(Left(Cells(1, j).Value, InStr(1, Cells(1, j).Value, "-") - 1))
intEnd = Val(Right(Cells(1, j).Value, Len(Cells(1, j).Value) - InStr(1, Cells(1, j).Value, "-")))
intCount = 1
For t = intBeg To intEnd
strArr(t) = Mid(Cells(I, j).Value, intCount, 1)
intCount = intCount + 1
Next t
End If
Next j
For t = 1 To UBound(strArr)
If strArr(t) = "" Then strArr(t) = " "
cellValue = cellValue + strArr(t)
Next t
Erase strArr
Print #1, cellValue
cellValue = ""
Next I
Close #1
Shell "C:\Windows\Notepad.exe C:\Reformatted.txt", 1
End Sub
I have procedure in VBA to write data to text file (.txt), but I need separeted values this char - "|". Can you help me?
Sub Sales_tmr()
Dim myFile As String
Dim rng As Range
Dim cellValue As Variant
Dim i As Integer
Dim j As Integer
myFile = Application.DefaultFilePath & "\sales.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, ' Here I will separeted char "|"
End If
Next j
Next i
Close #1
End Sub
Thanks!
Cant you just add it to the value?
cellValue = rng.Cells(i, j).Value
If j = rng.Columns.Count Then
Write #1, cellValue
Else
cellValue = cellValue & "|"
Write #1, cellValue, ' Here I will separeted char "|"
End If
UPDATED
To make it update each row in one go without quotes and commas. Move your write to after your first loop;
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
cellValue = cellValue & "|"
End If
Next j
Write #1, cellValue,
Next i
This will output
"Joe|Blogs|72",
"Dave|Mitchell|34",
etc
Please see the documentation to the VB Write function: http://msdn.microsoft.com/en-us/library/yxw69s8t%28v=vs.90%29.aspx
Unlike the Print function, the Write function inserts commas between items and quotation marks around strings as they are written to the file.
You will have to use a different function to write your lines to a file, e.g. by using Scripting.FileSystemObject and WriteLine. See http://msdn.microsoft.com/en-us/library/t5399c99%28v=vs.84%29.aspx
Can you try with the following object? Maybe that the Open myFile For Output As #1 has some kind of problem:
Dim SpaceVar as String
Dim Writer As Object
SpaceVar = Chr(124) ' Basically your "|"
Set Writer = CreateObject("ADODB.Stream")
With Writer
.Type = 2 ' Specifies stream type - save text data.
.Charset = "utf-8" ' Specifies charset for the source text data.
.lineseparator = 10 ' Pushes enter when a line is finished
.Open
End With
' Here you use the "Writer" Object as many times you want with the strings you want
Writer.WriteText NameVar & SpaceVar & SurnameVar & SpaceVar & AgeVar
' These variables I didn't declare, but you should in case you wanted to use them to store your strings
With Writer
.SaveToFile FileNameString, 2 ' Saves (and overwrites) data ' be sure to declare the variable, should you use it!
.Close
End With
Set Writer = Nothing