Help for macro to export to text file with certain amount of spaces.

[abjac]

Hi I would like if some can help me find a macro, which can convert a excel file to text file. And that the output text file look special. Need for and special application, to upload it to.

There is 3 columns in sheet 2. I want all lines to come out without spaces, the only special is that i want to have the - replaced with 183 blank spaces.

So the outlook file will look like this example.

200100000365595200019100014219920131120-40000041179  With no spaces
200330000001895490590500011996920131120   exactly 183 blank spaces             40000106363  
200330000001895490590500011996920131120   exactly 183 blank spaces             40000106363
200330000001895490590500011996920131120   exactly 183 blank spaces             40000106363

I have this below code for take it out to textfile but not sure it will work. It make spaces between all columns.

So any other macro would be great to have. I have attached a test sheet, where you can see the file before the conversion to text.

Have a look please.

Sincerely

Abjac

Sub DoTheExport()
Sheets(2).Activate
Dim FileName As Variant
    Dim Sep As String
    FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Text Files (*.txt),*.txt")
    If FileName = False Then
        ''''''''''''''''''''''''''
        ' user cancelled, get out
        ''''''''''''''''''''''''''
        Exit Sub
    End If
    Sep = Application.InputBox("                 ", Type:=2)
    If Sep = vbNullString Then
        ''''''''''''''''''''''''''
        ' user cancelled, get out
        ''''''''''''''''''''''''''
        Exit Sub
    End If
    Debug.Print "FileName: " & FileName, "Separator: " & Sep
    ExportToTextFile FName:=CStr(FileName), Sep:=CStr(Sep), _
       SelectionOnly:=False, AppendData:=True
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END DoTheExport


' This exports a sheet or range to a text file, using a
' user-defined separator character.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ExportToTextFile(FName As String, _
    Sep As String, SelectionOnly As Boolean, _
    AppendData As Boolean)

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String


Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile

If SelectionOnly = True Then
    With Selection
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
Else
    With ActiveSheet.UsedRange
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
End If

If AppendData = True Then
    Open FName For Append Access Write As #FNum
Else
    Open FName For Output Access Write As #FNum
End If

For RowNdx = StartRow To EndRow
    WholeLine = ""
    For ColNdx = StartCol To EndCol
        If Cells(RowNdx, ColNdx).Value = "" Then
            CellValue = Chr(34) & Chr(34)
        Else
           CellValue = Cells(RowNdx, ColNdx).Value
        End If
        WholeLine = WholeLine & CellValue & Sep
    Next ColNdx
    WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
    Print #FNum, WholeLine
Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum
Sheets(1).Activate

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END ExportTextFile

[Carl Willems]

Hi Abjac,
put in cell D2 the formula =REPLACE(CONCATENATE(A2;B2;C2);40;1;REPT(" ";183))

this should get you started

rgds,
Carl

[ragulduy]

function replace_183_spaces(str)
replace_183_spaces = replace(str,"-",worksheetfunction.rept(" ",183))
end function

use like:

Sub macro_1
dim str
str = replace_183_spaces("200100000365595200019100014219920131120-40000041179")

[abjac]

Hi Thanks Carl your formula is working, but i think i need some which can make the result in column A before i export to text file.

Yudligar. I tried yours but can really make it work. Its like nothing really happen when i use it. Could you have a look at the test sheet i have here and come with a suggertion.

Thanks to both for now

Sincerely Abjac

[ragulduy]

Hi,

I'm not sure what the issue is, I tried it on your example and it worked ok. For your fulll code you would use it like below, note, I had to take out the sheet(2).activate as this was selecting a blank worksheet:

Option Explicit
Sub DoTheExport()
Dim FileName As Variant
    Dim Sep As String
    FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Text Files (*.txt),*.txt")
    If FileName = False Then
        ''''''''''''''''''''''''''
        ' user cancelled, get out
        ''''''''''''''''''''''''''
        Exit Sub
    End If
    Sep = Application.InputBox("                 ", Type:=2)
    If Sep = vbNullString Then
        ''''''''''''''''''''''''''
        ' user cancelled, get out
        ''''''''''''''''''''''''''
        Exit Sub
    End If
    Debug.Print "FileName: " & FileName, "Separator: " & Sep
    ExportToTextFile FName:=CStr(FileName), Sep:=CStr(Sep), _
       SelectionOnly:=False, AppendData:=True
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END DoTheExport


' This exports a sheet or range to a text file, using a
' user-defined separator character.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ExportToTextFile(FName As String, _
    Sep As String, SelectionOnly As Boolean, _
    AppendData As Boolean)

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String


Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile

If SelectionOnly = True Then
    With Selection
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
Else
    With ActiveSheet.UsedRange
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
End If

If AppendData = True Then
    Open FName For Append Access Write As #FNum
Else
    Open FName For Output Access Write As #FNum
End If

For RowNdx = StartRow To EndRow
    WholeLine = ""
    For ColNdx = StartCol To EndCol
        If Cells(RowNdx, ColNdx).Value = "" Then
            CellValue = Chr(34) & Chr(34)
        Else
           CellValue = Cells(RowNdx, ColNdx).Value
        End If
        WholeLine = WholeLine & CellValue & Sep
    Next ColNdx
    WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
    Print #FNum, replace_183_spaces(WholeLine)
Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum
Sheets(1).Activate

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END ExportTextFile
Function replace_183_spaces(str)
replace_183_spaces = Replace(str, "-", WorksheetFunction.Rept(" ", 183))
End Function

[abjac]

Hi Yudlugar. I think this was closer. But in my code it ask me to put a space if i dont do, it will not work. My output look like this.

it make a space between column A and B and C, which it shall not and also its like the output is pushed so the digits after the 183 space is one "row" down in the text file. Please have a look .

Sincerely

Abjac

Ps. I think i solved the spaces, by removing the lines after the inputbox, where it exit sub. Maybe it can be done in other way.

But you have to see a real textfile in example notepad to see the digits, which are a moved one line down,.

Look like this::200100000365595200019100014219920131120 and the the 40000041179 are pushed one line down


Please try to do the export..

Thanks

2001000003655952000191 000142199 20131120                                                                                                                                                                                       40000041179
2003300000018954905905 000119969 20131120                                                                                                                                                                                       40000106363
2003300000018954905905 000119969 20131120                                                                                                                                                                                       40000106363
2003300000018954905905 000119969 20131120                                                                                                                                                                                       40000106363

[ragulduy]

Change

function replace_183_spaces(str)
replace_183_spaces = replace(str,"-",worksheetfunction.rept(" ",183))
end function

to

function replace_183_spaces(str)
replace_183_spaces = replace(replace(str," ",""),"-",worksheetfunction.rept(" ",183))
end function