VBA: Could not write cell values to text file

Question

I have an existing excel worksheet with data that is something like this:

Col A  Col B        Col C
123    17/1/1993    ABC
124    18/1/1993    DEF
125    19/1/1993    AAD
126    20/1/1993    AIG
127    21/1/1993    GBI

I want to write the data into a tab-delimited text file. With the following code, the text file created does not contain the values in the cells, although the tabs are written to the text file.

Sub writetotext()
    Dim lastrow As Long
    Dim lastcol As Long
    Dim i As Integer, j As Integer
    Dim celldata As String
    Dim fname As String
    Dim fso As Object

    Dim ws As Worksheet

    fname = ThisWorkbook.Path & "\textoutput.txt"
    lastrow = ThisWorkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
    lastcol =        ThisWorkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
    Set ws = ThisWorkbook.Sheets(1)

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFile = fso.CreateTextFile(fname)

    For i = 1 To lastrow
        For j = 1 To lastcol
            If j = lastcol Then
                celldata = celldata + ActiveCell(i, j).Value
            Else
                celldata = celldata + ActiveCell(i, j).Value + vbTab
            End If
        Next j
        objFile.writeline celldata
        celldata = ""
    Next i

    objFile.Close

End Sub

Seems like ActiveCell(i, j).Value does not work, but I don't know how to rectify this problem. I'm using Excel 2010

Answer 1

you can greatly reduce the length of your code by means of:

• arrays and their slicing methods

• instantiating a FileSystemObject file object "on the fly"

like follows:

Option Explicit

Sub writetotext()
    Dim i As Long
    Dim dataArr As Variant

    dataArr = ThisWorkbook.Sheets(1).UsedRange.Value '<--| store all values in an array
    With CreateObject("Scripting.FileSystemObject").CreateTextFile(ThisWorkbook.Path & "\textoutput.txt") '<--| instantiate a 'FileSystemObject' file object and reference it
        For i = 1 To UBound(dataArr, 1) '<--| loop through data array rows
            .writeline Join(Application.Index(dataArr, i, 0), vbTab) '<--| write current data array row values joined with vbtab delimeter
        Next i
        .Close '<--| close referenced instance of the 'FileSystemObject' file object
    End With
End Sub

Answer 2

You need to replace ActiveCell(i, j) with Cells(i, j) .

Also, to combine the text use & and not + , so your line should actualy look like celldata = celldata & Cells(i, j).Value & vbTab .

Option Explicit

Sub writetotext()

    Dim lastrow As Long
    Dim lastcol As Long
    Dim i As Long, j As Long
    Dim celldata As String
    Dim fname As String
    Dim fso As Object, objFile As Object

    Dim ws As Worksheet

    fname = ThisWorkbook.Path & "\textoutput.txt"
    Set ws = ThisWorkbook.Sheets(1)

    lastrow = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    lastcol = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Column

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFile = fso.CreateTextFile(fname)

    With ws
        For i = 1 To lastrow
            For j = 1 To lastcol
                If j = lastcol Then
                    celldata = celldata & .Cells(i, j).Value
                Else
                    celldata = celldata & .Cells(i, j).Value & vbTab
                End If
            Next j
            objFile.writeline celldata
            celldata = ""
        Next i
    End With

    objFile.Close

End Sub