Macro to export only cells w/ data from Excel to a text delimited file

0

Hi,

I'm trying to write a macro to export data from an excel file to a text delimited file. I have a worksheet with data in columns B to P up to row 112. I found the code below from this forum & you guys are awesome almost what I need, but I need to tweak the code a little bit more so it will be tab delimited rather that comma separated and only export/save to text file the cells with data. How can I tweak the code? or Do I need a totally different code?

Sub TEST()
    Dim c As Range, r As Range
    Dim output As String
    For Each r In Range("B13:P112").Rows
        For Each c In r.Cells
            output = output & c.Value & ","
        Next c
        output = output & vbNewLine
    Next r
    Open "C:\Desktop\Test\21855 EZ-28 Body.txt" For Output As #1
    Print #1, output
    Close
End Sub
 
Answer
Discuss

Answers

0

Thank you Don!! I use the output text file as a buffer file on a 3rd party SPC Software. The output on the SPC Software is different from Code 1 (your code) from Code 2 below, see attached. The problem w/ Code 2 it doesn't printout just the number data on B13:P112, I have to delete the output data results from A1:A112 and A1:I112 of the Excel file and only leave the number data.

What do you think it's giving me a different output on the SPC Software?

Code2:

Sub Auto_Open()
    Application.ScreenUpdating = False
 
    mySaveCopyAs ThisWorkbook, "C:\Desktop\Test\21855 EZ-28 Body.txt", xlTextWindows
    
 
    Application.ScreenUpdating = True
End Sub
 
Private Function mySaveCopyAs(pWorkbookToBeSaved As Workbook, pNewFileName As String, pFileFormat As XlFileFormat) As Boolean
 
    'returns false on errors
    On Error GoTo errHandler
 
 
 
     If pFileFormat = xlOpenXMLWorkbookMacroEnabled Then
        'no macros can be saved on this
        mySaveCopyAs = False
        Exit Function
    End If
 
    'create new workbook
    Dim mSaveWorkbook As Workbook
    Set mSaveWorkbook = Workbooks.Add
 
    Dim initialSheets As Integer
    initialSheets = mSaveWorkbook.Sheets.Count
 
 
    'note: sheet names will be 'Sheet1 (2)' in copy otherwise if
    'they are not renamed
    Dim sheetNames() As String
    Dim activeSheetIndex As Integer
    activeSheetIndex = pWorkbookToBeSaved.ActiveSheet.Index
 
    Dim i As Integer
    'copy each sheet
    For i = 1 To pWorkbookToBeSaved.Sheets.Count
        pWorkbookToBeSaved.Sheets(i).Copy After:=mSaveWorkbook.Sheets(mSaveWorkbook.Sheets.Count)
        ReDim Preserve sheetNames(1 To i) As String
        sheetNames(i) = pWorkbookToBeSaved.Sheets(i).Name
    Next i
 
    'clear sheets from new workbook
    Application.DisplayAlerts = False
    For i = 1 To initialSheets
        mSaveWorkbook.Sheets(1).Delete
    Next i
 
    'rename stuff
    For i = 1 To UBound(sheetNames)
        mSaveWorkbook.Sheets(i).Name = sheetNames(i)
    Next i
 
    'reset view
    mSaveWorkbook.Sheets(activeSheetIndex).Activate
 
    'save and close
    mSaveWorkbook.SaveAs filename:=pNewFileName, FileFormat:=pFileFormat, CreateBackup:=False
    mSaveWorkbook.Close
    mySaveCopyAs = True
 
    Application.DisplayAlerts = True
    Exit Function
 
errHandler:
    'whatever else you want to do with error handling
    mySaveCopyAs = False
    Exit Function
 
 
End Function
Discuss

Discussion

H,

I found out why there is a space in front of each row on the output text delimited file. Remove the space in between the quotes.

From:
output = output & " " & c.Value


To:
output = output & "" & c.Value


Thank you all!!! I hope this helps someone in the same situation as I was:-)
jacs_b1 Jul 17, '16 at 3:18 pm
That will remove all spaces from the line. Try out the code I posted below and see if that works. (Also, don't forget to select an answer!!! - If your answer worked the best then select it, that's not an issue [though I think you have to wait a day to select your own.])
don (rep: 1247) Jul 17, '16 at 3:31 pm
Add to Discussion
0

Try this code:

Sub TEST()

    Dim c As Range, r As Range
    Dim output As String
    Dim row_data As String

    For Each r In Range("B13:P112").Rows
        For Each c In r.Cells
            If c.Column = 2 Then
                row_data = c.Value
            Else
                row_data = row_data & " " & c.Value
            End If
        Next c
        output = output & row_data & vbNewLine
    Next r

    Open "D:\test.txt" For Output As #1
    Print #1, output
    Close

End Sub

You were very close but just needed to account for the fact that you were also adding a space to the data at the start of the row.

The code I posted here does not have a space for the first value in the row but does have a space for each value after that.

Discuss

Discussion

Hi Don,
Thank you for your help!!!

Please see my answer to your post above on my edited answer. I apologize I used that section becasue I cannot attach a file here
jacs_b1 Jul 17, '16 at 5:59 pm
Honestly, I'm a bit confused. It is better to update your original question if something has changed so other people who come here later can follow what is going on.

That said, I'm not sure what the issue is with this SPC software. Are you simply saying that the macro I gave you includes all rows in the range, even if they don't have data in them and you ONLY want cells that have data in them to be included?
don (rep: 1247) Jul 17, '16 at 7:36 pm
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login