Remove Carriage Return on Last Record in Excel export

[Lhuffst]

I have a procedure that exports a spreadsheet to a text file. It puts a carriage return after each row by default and the last record causes a blank row in the text (flat) file. Is there away to remove the last carriage return? Here is the code that I've used.

'
' Exportit Macro
' Macro recorded 6/18/2008 by lhuffst

Dim wbNew As Workbook
Set wbNew = Workbooks.Add
'
Dim NewDate As String

ThisWorkbook.Sheets.Add after:=Sheet1
lrow = Sheet1.UsedRange.Rows.Count
Set r1 = Sheet1.Range(Cells(2, 1), Cells(lrow, 3))
Set r1 = Application.Union(r1, Range(Cells(2, 7), Cells(lrow, 9)))
Set r2 = Sheet1.Range(Cells(4, "K"), Cells(lrow, "K"))

'Concatanate the fields
Dim counter
'columns are:  1-200ft sheet, 2-Work Order #, 3-PageGrid, 7-Date, 8-Rpt By, 9-condition Code
For counter = 2 To lrow
        NewDate = Format(Cells(counter, 7).Value, "mmddyy")       'removes the / on dates
        Cells(counter, "K").Value = _
        Cells(counter, 1).Value & _
        Cells(counter, 2).Value & _
        Cells(counter, 3).Value & _
        NewDate & _
        Cells(counter, 8).Value & _
        Cells(counter, 9).Value
        Debug.Print Mid(Cells(counter, 7).Value, 1, 2) & Mid(Cells(counter, 7).Value, 4, 2) & _
        Mid(Cells(counter, 7).Value, 7, 2)
        
Next counter

'copy to new sheet
'r1.Copy (Sheets(Sheets.Count).[a1])
'r2.Copy (Sheets(Sheets.Count).[a1])
r2.Copy wbNew.Sheets(1).[a1]
'save the new sheet
'Sheets(Sheets.Count).SaveAs Filename:="D:\My Data\FireHydrant Database\MainframeSide\testitNew.txt", FileFormat:=xlTextWindows
wbNew.Sheets(1).SaveAs Filename:="D:\My Data\FireHydrant Database\MainframeSide\testitToday.txt", FileFormat:=xlTextWindows
wbNew.Close
'delete the temporary sheet
Sheets(Sheets.Count).Delete

Thanks
lhuffst

 

[kjv1611]

Maybe...

For counter = 2 To lrow
      If counter = lrow Then
        'Don't add Carriage Return
      Else
        'Do add Carriage Return
      End If
Next counter

Basically, if you're looping through the rows, and adding the extra row after each one, then don't add the line when you get to the last one. I didn't see exactly where you were adding the blank line. If this doesn't do it, highlight that line for easier reference, and I'll take another look...

--

"If to err is human, then I must be some kind of human!" -Me

 

[Lhuffst]

It does it automatically. I don't actuallyl put the return in. I will try you suggestion. Thanks

 

[Lhuffst]

I am getting a blank line for every record that is saved in the saveas statement so I'm trying to change it to open a txt file and write the information out line by line. I keep getting an error in the section that is bolded. Can someone tell me 2 things
1. Why does the original wbnew.sheets(1).saveas line create an blank line at the end of the file.
The saved file has
record1
record2
.... record25
blank line 1
blank line 2
...... blank line 25


2. What am I doing wrong on the do loop? I thought that since I had already copied the data to a new sheet (wbnew), that I only had to make sure the sheet was active before I started writing the data. I continually get a run time error 1004 - application or object error.
Here is the code I'm using.

Dim wbNew As Workbook
Set wbNew = Workbooks.Add
'
Dim NewDate As String

ThisWorkbook.Sheets.Add after:=Sheet1
lrow = Sheet1.UsedRange.Rows.Count
Set r1 = Sheet1.Range(Cells(2, 1), Cells(lrow, 3))
Set r1 = Application.Union(r1, Range(Cells(2, 7), Cells(lrow, 9)))
Set r2 = Sheet1.Range(Cells(4, "K"), Cells(lrow, "K"))

'Concatanate the fields
Dim counter
'columns are:  1-200ft sheet, 2-Work Order #, 3-PageGrid, 7-RptBy, 8-Date, 9-condition Code
For counter = 2 To lrow
    
        NewDate = Format(Cells(counter, 8).Value, "mmddyy")       'removes the / on dates
        Cells(counter, "K").Value = _
        Cells(counter, 1).Value & _
        Cells(counter, 2).Value & _
        Cells(counter, 3).Value & _
        Cells(counter, 7).Value & _
        NewDate & _
        Cells(counter, 9).Value
        
'        Debug.Print Mid(Cells(counter, 7).Value, 1, 2) & Mid(Cells(counter, 7).Value, 4, 2) & _
'        Mid(Cells(counter, 7).Value, 7, 2)
        
Next counter
'For counter = 2 To lrow            didn't try this because the way the file was being saved
'      If counter = lrow Then
'        'Don't add Carriage Return
'      Else
'        'Do add Carriage Return
'      End If

'copy to new sheet
r2.Copy wbNew.Sheets(1).[a1]

'save the new sheet
'wbNew.Sheets(1).SaveAs Filename:="D:\My Data\FireHydrant Database\MainframeSide\testitToday.txt", FileFormat:=xlTextWindows
[b]
'switch to new sheet to start writing to output file
wbNew.Sheets("sheet1").Activate

Dim filepath As String
Dim I As Integer, recnum As Integer
recnum = 1
filepath = "\\Cobwin02\CustCareTeam\COB\Team Office\Fire Hydrant Painting\FHPAINTNew.txt"
Open filepath For Random As #1
    Do
    [red] the next line gets the run time error [/red]
        If ActiveSheet.Cells(I, "a").Value <> " " Then   'empty row so stop
            MsgBox (Help)
        End If
    Loop While (Cells(I, "a").Value <> "")
[/b]    
            
            

'Production site
wbNew.Sheets(1).SaveAs Filename:="\\Cobwin02\CustCareTeam\COB\Team Office\Fire Hydrant Painting\FHPAINT.txt", FileFormat:=xlTextWindows
wbNew.Close
'delete the temporary sheet
Sheets(Sheets.Count).Delete
'delete the extra sheet in the main workbook
ThisWorkbook.Activate
Sheet1.Range(Cells(3, "K"), Cells(lrow, "k")).ClearContents

 

[SkipVought]

This entire thread belongs in Forum707.

Give this a try. It reads the entire file into one string and chopps off the last two bytes (vbCrLf) and then writes it back...

Sub TrimTextFileContent()
    Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Dim fs, f, ts, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile("D:\My Data\FireHydrant Database\MainframeSide\testitNew.txt")
    
    Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
    s = ts.Readall
    s = Left(s, Len(s) - 2)
    ts.Close
    
    Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)
    ts.Write s
    ts.Close
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[PHV]

Replace this:
If ActiveSheet.Cells(I, "a").Value <> " " Then
with this:
If wbNew.Sheets("sheet1").Cells(I, "a").Value <> " " Then

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Lhuffst]

Thanks for the info. I can get all of the records and only 1 blank line now. Progress has been made! What I also figured out is that my lrow variable that is supposed to be counting only those rows with values, is counting 25 blank rows after that as well. That's why I was initially getting the 25 blank rows. Is there a formula that will check the value of the contents in the cell and only incrementthe usedrange.rows.count value based on that?

 

[SkipVought]

If you have FOMULAS in cells that return a null string, there is STILL something there.

Do View > Page Break Preview

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}