SOLVED

Macro - Create Tab Delimited *.txt from range

Brass Contributor

Hello Excel experts!

I am in need of a macro in Sheet A that creates a tab delimited blocks.txt file from range A36:C50 in Sheet B in directory C:\Users\user\Desktop\AsBuilt\blocks.txt

Also, since I will be using this same file to import blocks in AutoCAD, I wouldn't mind if the newly created file overwrites the previous without prompt.

Thank you!

18 Replies

@JoAvg 

Here is such a macro:

Sub SaveRangeAsText()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wt As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set ws = Worksheets("B")
    Set wb = Workbooks.Add(xlWBATWorksheet)
    Set wt = wb.Worksheets(1)
    wt.Range("A1:C15").Value = ws.Range("A36:C50").Value
    wb.SaveAs Filename:=Environ("userprofile") & "\Desktop\blocks.txt", _
        FileFormat:=xlUnicodeText
    wb.Close Savechanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

@Hans Vogelaar 

 

Thank you for the immediate reply.

I get Runtime error 9 - Subscript out of a Range for some reason.

Hope you can be of assistance...

@JoAvg 

If the sheet from which you want to export cells is not really named "B", change the line

 

Set ws = Worksheets("B")

 

accordingly.

@Hans Vogelaar 

I already did but I still get the error message...

Plus, I get a *txt named after the Sheet but in my Documents folder...

Does the wb.SaveAs Filename:=Environ("userprofile") & "\Desktop\blocks.txt" perhaps need to be changed also?

I cant seem to figure it out...

 

 

@JoAvg 

If you click Debug in the error message, which line is highlighted in yellow?

@Hans Vogelaar 

I don't get the the debug dialog.. just the dialog I posted ..

Sorry I am no good with VBA...

 

@JoAvg 

In the Visual Basic Editor, select Tools > Options...

Activate the General tab.

Under 'Error Trapping', select 'Break in Class Module'.

Click OK.

S1442.png

Run the macro again. Do you now see the Debug option?

@Hans Vogelaar 

Ok see it now.

JoAvg_0-1652817714983.png

This what I get.

 

@JoAvg 

Are you on Windows or on Mac?

Strange. let me see if I can come up with something.

best response confirmed by JoAvg (Brass Contributor)
Solution

@JoAvg 

Does this work?

Sub SaveRangeAsText()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wt As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set ws = Worksheets("B")
    Set wb = Workbooks.Add(xlWBATWorksheet)
    Set wt = wb.Worksheets(1)
    wt.Range("A1:C15").Value = ws.Range("A36:C50").Value
    wb.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\AsBuilt\blocks.txt", _
        FileFormat:=xlUnicodeText
    wb.Close Savechanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

@Hans Vogelaar

No, same thing...

JoAvg_0-1652819172218.png

 

 

@Hans Vogelaar 

Actually it does work!!!

I had deleted the AsBuilt folder and forgot to create it again for this code!!!

Thank you very much you have been of great help!!!!

@Hans Vogelaar 

Hans I got a question regarding the output txt file.

Below is the the way CAD software handles the exported file, space in the middle is a single tab.

JoAvg_2-1652823773462.png

However, when I save the file, the apostrophes at the beginning are missing, so is there a workaround to the code to make it export like the above?

Cells with the apostrophe are A36:A50.

 

Thanks ever so much for your help.

@JoAvg 

Try this:

Sub SaveRangeAsText()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim r As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set ws = Worksheets("B")
    Set wb = Workbooks.Add(xlWBATWorksheet)
    Set wt = wb.Worksheets(1)
    wt.Range("A1:C15").Value = ws.Range("A36:C50").Value
    For r = 1 To 15
        wt.Range("A" & r).Value = "'" & wt.Range("A" & r).Value
    Next r
    wb.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\AsBuilt\blocks.txt", _
        FileFormat:=xlUnicodeText
    wb.Close Savechanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

@Hans Vogelaar 

Same outcome. No quote at the beginning.

Maybe it has to do with the fact that the prefixed single quote indicates the cell contents as text?

@JoAvg 

What happens if you change the line

        wt.Range("A" & r).Value = "'" & wt.Range("A" & r).Value

to

        wt.Range("A" & r).Value = "''" & wt.Range("A" & r).Value

@Hans Vogelaar 

Same outcome. Won't change.

But! I concatenated the cell I want with double quotes " '' " and it exports as it is supposed to!

Also, the code creates a file with countless blanks lines at the end, so I replaced the 

wt.Range("A" & r).Value = "'" & wt.Range("A" & r).Value

with 

ws.Range("A" & r).Value = "''" & ws.Range("A" & r).Value

and it stops right at the bottom of the range.

I don't know if it is correct but it works and returns no faults!

 

1 best response

Accepted Solutions
best response confirmed by JoAvg (Brass Contributor)
Solution

@JoAvg 

Does this work?

Sub SaveRangeAsText()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wt As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set ws = Worksheets("B")
    Set wb = Workbooks.Add(xlWBATWorksheet)
    Set wt = wb.Worksheets(1)
    wt.Range("A1:C15").Value = ws.Range("A36:C50").Value
    wb.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\AsBuilt\blocks.txt", _
        FileFormat:=xlUnicodeText
    wb.Close Savechanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

View solution in original post