S
Stryves
Hello, this is my first post on a very old subject.
There are 2 changes I'd like to make to this code.
1. I'd like it not to ask for a filename, and use the Worksheet name
instead.
2. This code save a Tab separated text file, I'd like to use Comma's
instead.
I tried changing vbTab to vbComma, but then I get an error on the line
"CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)".
Any assistance would be appreciated!
Sub OutputActiveSheetAsTabDelim()
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant
Dim ColCount As Integer
Dim CurrCol As Integer
FName = Application.GetSaveAsFilename("", "Tab Delimited File
(*.txt),*.txt")
If FName <> False Then
ListSep = vbTab ''Chg to comma, etc for a different separator
If Selection.Cells.Count > 1 Then
Set SrcRg = Selection
Else
Set SrcRg = ActiveSheet.UsedRange
End If
ColCount = SrcRg.Columns.Count
Open FName For Output As #1
For Each CurrRow In SrcRg.Rows
CurrCol = 0
CurrTextStr = ""
For Each CurrCell In CurrRow.Cells
CurrCol = CurrCol + 1
CurrTextStr = CurrTextStr & CurrCell.Value & ListSep
Next
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
Print #1, CurrTextStr
Next
Close #1
End If
End Sub
There are 2 changes I'd like to make to this code.
1. I'd like it not to ask for a filename, and use the Worksheet name
instead.
2. This code save a Tab separated text file, I'd like to use Comma's
instead.
I tried changing vbTab to vbComma, but then I get an error on the line
"CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)".
Any assistance would be appreciated!
Sub OutputActiveSheetAsTabDelim()
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant
Dim ColCount As Integer
Dim CurrCol As Integer
FName = Application.GetSaveAsFilename("", "Tab Delimited File
(*.txt),*.txt")
If FName <> False Then
ListSep = vbTab ''Chg to comma, etc for a different separator
If Selection.Cells.Count > 1 Then
Set SrcRg = Selection
Else
Set SrcRg = ActiveSheet.UsedRange
End If
ColCount = SrcRg.Columns.Count
Open FName For Output As #1
For Each CurrRow In SrcRg.Rows
CurrCol = 0
CurrTextStr = ""
For Each CurrCell In CurrRow.Cells
CurrCol = CurrCol + 1
CurrTextStr = CurrTextStr & CurrCell.Value & ListSep
Next
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
Print #1, CurrTextStr
Next
Close #1
End If
End Sub