EDIT: I CHANGED THIS ORIGINAL POST SO I COULD EMBED THE FINAL CODE I WENT WITH.
Using the code at the bottom to export a specific worksheet and convert to a CSV file.
The output file will consistently have the very first line beginning with a blank space followed by the string
,,Primary,Secondary,Tertiary
I would like to remove/replace that line with a newline. i.e..
CURRENT:
,,Primary,Secondary,Tertiary
100,106,2165483624,2165483624,8133181331
I would like to remove/replace that top line with a newline. i.e:
(newline here)
100,106,2165483624,2165483624,8133181331
That line will always be the first line, and will be the only line beginning with a space and two commas, also the only one with the words Primary,Secondary,Tertiary comma-delimited.
I've spent several hours checking this site and others but either
I'm using the wrong keywords or my desired outcome hasn't been
documented yet. Thanks in advance.
CODE I ENDED UP USING IS BELOW
Sub btn_Export_to_CSV_Click()
Dim csvFilePath As String
Dim fileNo As Integer
Dim fileName As String
Dim oneLine As String
Dim lastRow, lastCol As Long
Dim idxRow, idxCol As Long
' --- get this file name (without extension)
fileName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".", -1, vbTextCompare) - 1)
' --- create file name of CSV file (with full path)
csvFilePath = ActiveWorkbook.Path & "\" & fileName & ".csv"
' --- get last row and last column
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
' --- open CSC file
fileNo = FreeFile
Open csvFilePath For Output As #fileNo
Print #fileNo, "" ' -- write one blank line
' --- row loop
For idxRow = 2 To lastRow
oneLine = ""
' --- column loop: concatenate oneLine
For idxCol = 1 To lastCol
If (idxCol = 1) Then
oneLine = Cells(idxRow, idxCol).Value
Else
oneLine = oneLine & "," & Cells(idxRow, idxCol).Value
End If
Next
' --- write oneLine > CSV file
Print #fileNo, oneLine ' -- Print: no quotation (output oneLine as it is)
Next
' --- close file
Close #fileNo
MsgBox "CSV file completed !!" & Chr(13) & csvFilePath
End Sub
Related
I am adding some data in the first column of a worksheet and am using this code
Sub createCSVfile()
Dim xRg As Range
Dim xRow As Range
Dim xCell As Range
Dim xStr As String
Dim xTxt As String
Dim xName As Variant
ThisWorkbook.Worksheets("Tabelle1").Range("A1").Value = "XYZ"
ThisWorkbook.Worksheets("Tabelle1").Range("A2").Value = "XYZ"
ThisWorkbook.Worksheets("Tabelle1").Range("A3").Value = "XYZ"
ThisWorkbook.Worksheets("Tabelle1").Range("A4").Value = "XYZ"
ThisWorkbook.Worksheets("Tabelle1").Range("A5").Value = "XYZ"
Set xRg = ThisWorkbook.Worksheets("Tabelle1").Range("A1:A5")
xName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
Open xName For Output As #1
For Each xRow In xRg.Rows
xStr = ""
For Each xCell In xRow.Cells
xStr = xStr & xCell.Value & Chr(9)
Next
While Right(xStr, 1) = Chr(9)
xStr = Left(xStr, Len(xStr) - 1)
Wend
Print #1, xStr
Next
Close #1
If Err = 0 Then MsgBox "csv file saved"
End Sub
to save it as csv and delete all quotation marks based on this tutorial.
When I open the csv with Notepad there always is at least one blank line at the end:
It does not make a difference if I save the file manually - same blank line. I also tried to add something like
ThisWorkbook.Worksheets("Tabelle1").Rows(6).Delete
but it doesn't make a difference because there are no values in the 6th row of the worksheet.
Is there a way to counter this or at least automate deleting the last line in the csv via Notepad?
There is no blank row. You got 5 rows, each ended with a CR/LF (Carriage Return and Line Feed). The Text Editor gives you an empty 6th line.
To avoid this you would have to delete the CR/LF from the 5th row but that is not usually done.
It is fine as it is.
as Wolfgang Jacques suggested in the comments, I used this method instead of SaveWorkbookAs
Sub CreateAfile
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\testfile.txt", True)
a.WriteLine("This is a test.")
a.Close
End Sub
and for the last entry I used a.Write instead of a.WriteLine
I am creating a csv as semi colon seperated, but the file output of csv has a blank line at top.
Please help me what needs to update in my below code
Sub WriteToCSV()
Dim FileNumber As Long
Dim temp As String
Dim cl As Range
Dim rw As Range
FileNumber = FreeFile '
'get a new file number
FileNumber = FreeFile
' change path & file name as required
Open "C:\Users\standard\Desktop\automation\ankur.csv" For Output As #FileNumber
Print #FileNumber, temp
'change the worksheet index by its real position or Name between quotes, eg Worksheets("Sheet1").
For Each rw In Worksheets(1).Range("A1").CurrentRegion.Rows
For Each cl In rw.Cells
temp = temp & cl.Value & ";"
Next cl
Print #FileNumber, temp
're=initialise string
temp = ""
Next rw
Close #FileNumber
End Sub
Your code has Print #FileNumber, temp immediately after opening the file for output. As temp has not been set to anything, it is an empty string, hence the blank line.
Also, you don't need to use FreeFile twice.
Regards,
I am trying to import special characters from a txt file into excel.
I've tried so many things but the characters BREAK in excel.
example of my string:
in txt: Changjíhuízúzìzhìzhou
converts in excel to: ChangjÃhuÃzúzìzhìzhou
so I tried moving values over bit by bit but no luck..
Sub ImportTXTFile()
Dim file As Variant
Dim EXT As String
Dim Direct As String ' directory...
Direct = "C:\FilePath\Here\"
EXT = ".txt"
Dim COL As Long
Dim row As Long
COL = 1
row = 1
file = Dir(Direct)
Do While (file <> "") ' Cycle through files until no more files
If InStr(file, "Data.txt") > 0 Then
'
Open Direct & "Data.txt" For Input As #1
'
While Not EOF(1)
Line Input #1, DataLine ' Read in line
Do While DataLine <> ""
If InStr(DataLine, ",") = 0 Then ' Drop value into excel upto the first ,
Sheets("test").Cells(row, COL).Value = DataLine
DataLine = ""
Else
Sheets("test").Cells(row, COL).Value = Left(DataLine, InStr(DataLine, ",") - 1)
DataLine = Right(DataLine, Len(DataLine) - InStr(DataLine, ",")) ' rebuild array without data upto first ,
End If
COL = COL + 1 ' next column
Loop
COL = 1 ' reset column
row = row + 1 ' write to next row
Wend
'
Close #1 ' Close files straight away
End If
file = Dir
Loop
MsgBox "Data Updated"
End Sub
So I want to cry because all this converting of UTF-8 to ASCII can be avoid simply by:
opening the txt file in Notepad++
going to the encoding tab
clicking convert to ASCII
ran my original code.
BLAM
everything is perfect.
Thank you danieltakeshi for all your help!
Using the first link i gave you, here is a test code, i tested with success. Using the charset: CdoISO_8859_1
Dim objStream As Object
Dim strData As String
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "iso-8859-1"
objStream.Open
objStream.LoadFromFile ("C:\Users\user_name\Desktop\test.txt")
strData = objStream.ReadText()
Debug.Print strData & " Compare to: Changjíhuízúzìzhìzhou"
The output was:
EDIT:
Check the encoding type of your .txt file and import to Excel with the same encoding charset, for example, i changed the test.txt to UTF-8 and imported successfully with the .Charset as "utf-8"
You can Save As your .txt file and choose the encoding.
Through a Excel VBA macro, I'm trying to print up to 10 space seperated arguments for a selected range in excel.
For example, I have the 24 values in my selection range A1:A24 - (say Val1, Val2, Val3, Val4, etc.)
Using the following VBA code, I want to get the output in the "outfile.bat" as
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" Val1 Val2.... Val10
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" Val11 Val2.... Val20
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" Val21 Val22 Val23 Val24
i.e. each line should get printed with maximum of 10 argument values (seperated by a space). Anything above that should be moved to next line (again max of 10 space seperated arguments)
Somehow, the following code is
(1) NOT keeping the output to the same line and
(2) Inserts a newline at the 10th value, but not at the 20th, 30th and other values.
It produces the following:
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
Val1
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
Val2
C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
Val3
and so on....
Here is my code:
Private Sub GetChromeFile_Click()
Dim myFile As String, rng As Range, cellValue As Variant, i As Integer, j As Integer, a As Integer
myFile = "C:\Users\User1\" & "outfile.bat"
Set rng = Selection
Open myFile For Output As #7
a = 0
For i = 1 To rng.Rows.Count
Print #7, Chr(34) & "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & Chr(34)
a = a + 1
cellValue = rng.Cells(i).Value
If (a = 10) Then
Print #7, " " & cellValue & vbNewLine
Else
Print #7, " " & cellValue
End If
Next i
Close #7
Range("F5").Value = " Done!"
End Sub
Please let me know where this may be going wrong.
Thanks
The print statement prints a line to the file, so adding vbNewLine at the end of each is redundant. You're also making calls to Print for each argument value (cellValue in your code), which is why those are appearing on their own line.
You can most likely construct the entire file contents as a single string, and then use a single Print statement to write the whole file. If you're dealing with an enormous amount of data, you may need to segment it but for most cases this should work:
Option Explicit
Sub writebat()
Const pathTxt$ = """C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"" "
Dim lineTxt As String
Dim cellValue As String
Dim fname As String
Dim ff As Long
Dim a As Long
Dim i As Long
Dim rng As Range
Set rng = Selection ' Range("A1:A37")
fname = "C:\Users\User1\" & "outfile.bat" ' "C:\debug\output.txt"
ff = FreeFile()
Open fname For Output As #ff
lineTxt = pathTxt
a = 1
For i = 1 To rng.Rows.Count
'## Add the cell value to the string
lineTxt = lineTxt & rng.Cells(i).Value & " "
If a Mod 10 = 0 Then
'## Start a new line with the executable path
lineTxt = lineTxt & vbNewLine & pathTxt
End If
a = a + 1
Next
Print #ff, lineTxt
Close #ff
End Sub
This yields the following output:
I hope you can help with a VBA problem I'm trying to solve.
My situation:
I have multiple txt files as input for the search of a particular string ("tflux"). In every txt file the string is present so it is not possible that it is not found. I've written the code below, but I cannot find a way to tell excel that after copying the value that is related to the found string it has to move one cell lower for the next found value that is related to the next file it searches. Although I didn't try yet, I also would like excel to print the file name next to the numbers to be sure that the values correspond to a certain file name.
My VBA code so far:
Sub CommandButton1_Click()
Dim strF As String, strP As String, text As String, textline As String, tFlux As Integer
strP = "C:\test" 'change for the path of your folder
strF = Dir(strP & "\*.txt") 'Change as required
Do While strF <> vbNullString
Open strF For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
tFlux = InStr(text, "tflux")
Range("B2").Value = Mid(text, tFlux + 9, 3) <----- this is the line where I need help, Now the last found value is copied into cell B2, but I want excel to move to B3 after filling B2, move to B4 after filling B3, etc....
Loop
Close #1
text = ""
strF = Dir()
Loop
End Sub
The answer of VBA Pete will do the desired moving down for each found value. But I want to warn you about another, important problem in your code:
Line Input #1, textline
text = text & textline
tFlux = InStr(text, "tflux")
The above code has two problems. First, each time you read a line you append it to the previous text from the file, and you restart the search from the file's beginning. This is very slow, but moreover, it is wrong because if there are many occurrences of "tflux" in the file, you will always catch the first occurrence. Even if there is only one occurrence, you will catch it and report it many times each time you read a new line.
The second line of the above could should be rewritten this way:
text = textline ' <-- just copy the line, don't append it to previous lines from the file
How about a long variable that moves one value up in the range each time it runs through the loop:
Sub CommandButton1_Click()
Dim strF As String, strP As String, text As String, textline As String
Dim tFlux As Integer strP = "C:\test" 'change for the path of your folder
Dim x as long
strF = Dir(strP & "*.txt") 'Change as required
Do While strF <> vbNullString
x = 2
Open strF For Input As #1 Do Until EOF(1)
Line Input #1, textline
text = text & textline
tFlux = InStr(text, "tflux")
Range("B" & x).Value = Mid(text, tFlux + 9, 3)
x = x + 1
Loop
Close #1 text = "" strF = Dir() Loop
End Sub
I would recommend that you refactor your code as follows:
Sub CommandButton1_Click()
Dim strF As String, strP As String, textline As String, tFlux As Integer
Dim r As Long ' to keep track of which row we are writing to
strP = "C:\test" 'change for the path of your folder
strF = Dir(strP & "\*.txt") 'Change as required
r = 2 ' first line of output will go to row 2
Do While strF <> vbNullString
Open strF For Input As #1
Do Until EOF(1)
Line Input #1, textline
tFlux = InStr(textline, "tflux")
'See if we found "tflux"
If tFlux > 0 Then
'Found it - store the associated value
Cells(r, "B").Value = Mid(textline, tFlux + 9, 3)
'Store the filename too
Cells(r, "C").Value = strF
r = r + 1 ' set row pointer ready for next file
Exit Do ' found and processed - no need to keep looking within this file
End If
Loop
Close #1
strF = Dir()
Loop
End Sub
I included an Exit Do inside the "read file" loop so that, as soon as it finds the information you are looking for, it exits the loop. That saves time by not having to continue reading the rest of the file looking for something that you know won't be there.