Export to Text without Quotation Marks-CodePudding

I have multiple worksheets in my workbook. Each worksheet has two columns of data (ColA and ColC) which I want to print to separate text files. The attached code results in two text files: “WorksheetTab_LnFn.txt” and “WorksheetTab_FnLn.txt” The text file saved from my ColA does NOT quotations whilst the second text file saved from my ColC DOES HAVE quotation marks - I want each resulting text file to NOT have quotation marks.

I may have worksheets later with data in ColA, ColC, ColE and ColG, each of which I want to export/save/print to a text file – thus I would want in that case four separate text document, all WITHOUT quotation marks.

The best code I have been able to find is locate is: Write export of selected cells as a .txt file without "quotation marks" and I have looked at How to create a text file using excel VBA without having double quotation marks?.

I understand most of it, but am not being successful at integrating parts of this code into mine. Ideally I am seeking to reduce the code and loop so it would process ColA and then ColB without having two separate code blocks. I did use code I found and made minimal changes, but do not know if the Case LCase line is necessary

        'Create FirstName LastName Isolation TXT files
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
            For Each sh In Sheets
                Select Case LCase(sh.Name)
                    Case LCase("[COLOR=#0000ff]Master[/COLOR]"), LCase("[COLOR=#0000ff]Info[/COLOR]")
                    Case Else
                        sh.Range("A:A").Copy
                        Workbooks.Add
                        ActiveSheet.Paste
                        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & sh.Name & "_FnLn.txt", _
                            FileFormat:=xlTextMSDOS, CreateBackup:=False
                        ActiveWorkbook.Close False
                End Select
            Next

        'Create LastName FirstName Isolation TXT files
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
            For Each sh In Sheets
                Select Case LCase(sh.Name)
                    Case LCase("[COLOR=#0000ff]Master[/COLOR]"), LCase("[COLOR=#0000ff]Info[/COLOR]")
                    Case Else
                        sh.Range("C:C").Copy
                        Workbooks.Add
                        ActiveSheet.Paste
                        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & sh.Name & "_LnFn.txt", _
                            FileFormat:=xlTextMSDOS, CreateBackup:=False
                        ActiveWorkbook.Close False
                End Select
            Next
    
            MsgBox "Text Files Created"
        End Sub

CodePudding user response：

This should do what you want:

Sub Tester()
    Dim filename As String, myrng As Range, sh As Worksheet, wb As Workbook
    Set wb = ThisWorkbook
    For Each sh In wb.Worksheets
        
        filename = wb.Path & "\" & sh.Name & "_FnLn.txt"
        Set myrng = sh.Range("C1:C" & sh.Cells(sh.Rows.Count, "C").End(xlUp).Row) 'use sh reference
        
        RangeToTextFile myrng, filename             'comma-separated
        'RangeToTextFile myrng, filename, vbtab     'e.g. for tab-separated file
    Next
    
    MsgBox "Text Files Created"
End Sub

'write a range `rng` to a text file at `fPath`.  Default separator is comma
Sub RangeToTextFile(rng As Range, fPath As String, Optional separator As String = ",")
    Dim data, r As Long, c As Long, sep, lo As String, ff As Integer
    
    ff = FreeFile()                     'safer than using hard-coded #1
    Open fPath For Output As #ff
    
    If rng.Cells.CountLarge = 1 Then
        ReDim data(1 To 1, 1 To 1)      'handle special case of single cell
        data(1, 1) = rng.Value
    Else
        data = rng.Value                'get all values as an array
    End If
    
    For r = 1 To UBound(data, 1)        'loop rows
        lo = ""                         'clear line output
        sep = ""                        'clear separator
        For c = 1 To UBound(data, 2)    'loop columns
            lo = lo & sep & data(r, c)  'build the line to be written
            sep = separator             'add separator after first value
        Next c
        Print #ff, lo                   'write the line
    Next r
    Close #ff
End Sub