May 17 2022 09:51 AM
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!
May 17 2022 10:26 AM
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
May 17 2022 11:22 AM
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...
May 17 2022 11:38 AM
If the sheet from which you want to export cells is not really named "B", change the line
Set ws = Worksheets("B")
accordingly.
May 17 2022 12:00 PM
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...
May 17 2022 12:16 PM
If you click Debug in the error message, which line is highlighted in yellow?
May 17 2022 12:46 PM
I don't get the the debug dialog.. just the dialog I posted ..
Sorry I am no good with VBA...
May 17 2022 12:57 PM
In the Visual Basic Editor, select Tools > Options...
Activate the General tab.
Under 'Error Trapping', select 'Break in Class Module'.
Click OK.
Run the macro again. Do you now see the Debug option?
May 17 2022 01:07 PM
May 17 2022 01:10 PM - edited May 17 2022 01:11 PM
May 17 2022 01:15 PM
SolutionDoes 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
May 17 2022 01:26 PM
May 17 2022 01:29 PM
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!!!!
May 17 2022 03:07 PM
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.
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.
May 18 2022 12:23 AM
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
May 18 2022 01:48 AM
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?
May 18 2022 04:08 AM
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
May 18 2022 05:26 AM
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!
May 17 2022 01:15 PM
SolutionDoes 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