Exporting Single column as .txt file

Hello,

I need help creating a macro that will take the data in a column and extract it all as a .txt file or if possible a .bat file. I would like that file saved in the same place the the workbook is saved.

For Example:

If i had data in a range of cells from A1:E50, how would i be able to extract the data E1:E50 as a .txt or .bat file saved in the same file location as the workbook with the data.

Hi Zlerp,

AFAIK, a .bat file is likely to be recognized as MS-DOS script file, so I chose .txt.

In a Standard Module:

Code:

---

Option Explicit
 
Sub Example()
Dim FSO          As Object ' Scripting.FileSystemObject
Dim fsoTStream    As Object ' Scripting.TextStream
Dim arrRangeData  As Variant
Dim sVersion      As String
Dim sPath        As String
Dim n            As Long
 
  Set FSO = CreateObject("Scripting.FileSystemObject")
 
  sPath = PF(ThisWorkbook.Path)
  arrRangeData = Sheet1.Range("E1:E50").Value
 
  If Not FSO.FileExists(sPath & "Output.txt") Then
    Set fsoTStream = FSO.CreateTextFile(sPath & "Output.txt", False)
  Else
    n = 0
    Do While FSO.FileExists(sPath & "Output" & sVersion & ".txt")
      n = n + 1
      sVersion = Format(n, "000")
    Loop
    If Not n = 999 Then
      Set fsoTStream = FSO.CreateTextFile(sPath & "Output" & sVersion & ".txt", False)
    Else
      MsgBox "Too many files...", vbExclamation, vbNullString
      Exit Sub
    End If
  End If
 
  For n = 1 To UBound(arrRangeData, 1)
    fsoTStream.WriteLine arrRangeData(n, 1)
  Next
 
  fsoTStream.Close
 
End Sub
 
'Path Fixed
Function PF(Path As String, Optional IncludeTrailingSeperator As Boolean = True) As String
 
  Do While Right$(Path, 1) = "\"
    Path = Left$(Path, Len(Path) - 1)
  Loop
 
  If IncludeTrailingSeperator Then Path = Path & "\"
 
  PF = Path
 
End Function

---

See the attached. Does that help?

Mark

Here's another..

Code:

---

Private Sub CommandButton1_Click()
  Dim Rng As Range
        With CreateObject("Scripting.FileSystemObject").CreateTextFile(ThisWorkbook.Path & "Test" & ".txt", True)
            Set Rng = Cells(1, 5).Resize(50, 1)
            .writeline Join(Application.Transpose(Rng), vbCrLf)
        End With
End Sub

---

Code:

---

Private Sub CommandButton1_Click()
    CreateObject("Scripting.FileSystemObject").CreateTextFile(ThisWorkbook.Path & "\Test.txt").write Join([transpose(E1:E50)], vbCrLf)
End Sub

---

Very nice indeed snb.. :)

Hey looking into it all now. Thanks

Quote:

---

Originally Posted by GTO

Hi Zlerp,

AFAIK, a .bat file is likely to be recognized as MS-DOS script file, so I chose .txt.

In a Standard Module:

Code:

---

Option Explicit
 
Sub Example()
Dim FSO          As Object ' Scripting.FileSystemObject
Dim fsoTStream    As Object ' Scripting.TextStream
Dim arrRangeData  As Variant
Dim sVersion      As String
Dim sPath        As String
Dim n            As Long
 
  Set FSO = CreateObject("Scripting.FileSystemObject")
 
  sPath = PF(ThisWorkbook.Path)
  arrRangeData = Sheet1.Range("E1:E50").Value
 
  If Not FSO.FileExists(sPath & "Output.txt") Then
    Set fsoTStream = FSO.CreateTextFile(sPath & "Output.txt", False)
  Else
    n = 0
    Do While FSO.FileExists(sPath & "Output" & sVersion & ".txt")
      n = n + 1
      sVersion = Format(n, "000")
    Loop
    If Not n = 999 Then
      Set fsoTStream = FSO.CreateTextFile(sPath & "Output" & sVersion & ".txt", False)
    Else
      MsgBox "Too many files...", vbExclamation, vbNullString
      Exit Sub
    End If
  End If
 
  For n = 1 To UBound(arrRangeData, 1)
    fsoTStream.WriteLine arrRangeData(n, 1)
  Next
 
  fsoTStream.Close
 
End Sub
 
'Path Fixed
Function PF(Path As String, Optional IncludeTrailingSeperator As Boolean = True) As String
 
  Do While Right$(Path, 1) = "\"
    Path = Left$(Path, Len(Path) - 1)
  Loop
 
  If IncludeTrailingSeperator Then Path = Path & "\"
 
  PF = Path
 
End Function

---

See the attached. Does that help?

Mark

---

Hey Mark,

Figured it out! Thanks for the help. Updated it slightly. check it out!

Option Explicit

Sub Example()
Dim FSO As Object ' Scripting.FileSystemObject
Dim fsoTStream As Object ' Scripting.TextStream
Dim arrRangeData As Variant
Dim sVersion As String
Dim sPath As String
Dim n As Long
Dim lastRow As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
lastRow = FindLastRow(ActiveSheet, "J")

sPath = PF(ThisWorkbook.Path)
arrRangeData = Sheet1.Range("J1:J" & lastRow).Value

If Not FSO.FileExists(sPath & "Output.txt") Then
Set fsoTStream = FSO.CreateTextFile(sPath & "Output.txt", False)
Else
n = 0
Do While FSO.FileExists(sPath & "Output" & sVersion & ".txt")
n = n + 1
sVersion = Format(n, "000")
Loop
If Not n = 999 Then
Set fsoTStream = FSO.CreateTextFile(sPath & "Output" & sVersion & ".txt", False)
Else
MsgBox "Too many files...", vbExclamation, vbNullString
Exit Sub
End If
End If

For n = 1 To UBound(arrRangeData, 1)
fsoTStream.WriteLine arrRangeData(n, 1)
Next

fsoTStream.Close

End Sub

'Path Fixed
Function PF(Path As String, Optional IncludeTrailingSeperator As Boolean = True) As String

Do While Right$(Path, 1) = "\"
Path = Left$(Path, Len(Path) - 1)
Loop

If IncludeTrailingSeperator Then Path = Path & "\"

PF = Path

End Function
Public Function FindLastRow(ByVal WS As Worksheet, ColumnLetter As String) As Long
' this function will find the last row of the worksheet and column that you
' request
FindLastRow = WS.Range(ColumnLetter & Rows.Count).End(xlUp).Row
End Function

Quote:

---

Originally Posted by Zlerp

Hey Mark,

Figured it out! Thanks for the help. Updated it slightly. check it out!

---

You are most welcome and glad you got it working.:thumb

I would comment on one little part though:

Code:

---

  lastRow = FindLastRow(ActiveSheet, "J")

---

In calling FindLastRow(), you are sending a reference to the ActiveSheet to the Function.

Code:

---

arrRangeData = Sheet1.Range("J1:J" & lastRow).Value

---

In returning arrRangeData, the values from a range of Sheet1 (the CodeName, not the one on the tab) is being returned. Thus if another sheet happens to be active when the code runs, the last cell with data on that sheet is what sets lastRow. See what I mean? So it should either be ActiveSheet in both places, or specify which sheet explicitly in both places.

Hope that helps,

Mark

Quote:

---

Originally Posted by GTO

You are most welcome and glad you got it working.:thumb

I would comment on one little part though:

Code:

---

  lastRow = FindLastRow(ActiveSheet, "J")

---

In calling FindLastRow(), you are sending a reference to the ActiveSheet to the Function.

Code:

---

arrRangeData = Sheet1.Range("J1:J" & lastRow).Value

---

In returning arrRangeData, the values from a range of Sheet1 (the CodeName, not the one on the tab) is being returned. Thus if another sheet happens to be active when the code runs, the last cell with data on that sheet is what sets lastRow. See what I mean? So it should either be ActiveSheet in both places, or specify which sheet explicitly in both places.

Hope that helps,

Mark

---

Hey Mark,

Thanks for the Tips and information. I'll make those changes!

Happy to help. :beerchug: