Copy range and save as a new text file

[spycein]

Hello everyone,
I looking for a VBA macro code which would copy a specified column range and save the same as text file.
For example, when i click the command button the code will copy the assigned range and ask for the path & file name to save the file.
Regards,
Shib

 

[kennypete]

This should work, letting you select columns, rows, or a range and saves the file as TXT (with tabs, but that could be changed). It does not copy anything or make new sheets, it just takes the selection (or trims it if whole columns or rows are selected to the last used cell in the column or row) and saves it. Note it requires the worksheet to be Sheet1.

Option Explicit
Sub SaveTXTselection()
    
    Dim strLine As String
    Dim intRow As Integer
    Dim booFirstCell As Boolean
    If Selection.Address = "$1:$1048576" Then Range(Sheet1.UsedRange.Address).Select ' if the whole sheet is selected then reduce it to the used range
    If UBound(Split(Selection.Address, "$")) = 2 Then
    ' whole column(s) or whole row(s) selected so we need to limit the output to the used range within the columns or rows
        If IsNumeric(Split(Split(Selection.Address, "$")(1), ":")(0)) Then
            ' whole row(s), so re-select to column A plus the extent of the used range's columns since the rest is empty
            Range("A" & Split(Selection.Address, "$")(1) & Split(Sheet1.UsedRange.Address, "$")(3) & Split(Selection.Address, "$")(2)).Select
        Else
            ' whole column(s), so re-select row 1 plus the extent of the used range's rows since the rest is empty
            Range(Split(Split(Selection.Address, "$")(1), ":")(0) & "1:" & Split(Selection.Address, "$")(2) & Split(Sheet1.UsedRange.Address, "$")(4)).Select
        End If
    End If
    intRow = Split(Split(Selection.Address, "$")(2), ":")(0)
    booFirstCell = True
    
    Dim varSaveAsTxt As Variant
    ' displays the save file dialog (file name only required, the .txt will be added)
    varSaveAsTxt = Application.GetSaveAsFilename(FileFilter:="Text (Tab delimited) (*.txt), *.txt")
    ' check to make sure the user hasn't pressed cancel
    If varSaveAsTxt = False Then Exit Sub
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim oFile As Object
    Set oFile = fso.CreateTextFile(varSaveAsTxt)
    Dim cell As Object
    
    ' Go through each selected cell and write it
    For Each cell In Selection
        If Split(cell.Address, "$")(2) > intRow Then
            oFile.writeline strLine
            intRow = intRow + 1
            strLine = cell.Value
        ElseIf booFirstCell Then
            strLine = cell.Value
            booFirstCell = False
        Else
            strLine = strLine & Chr(9) & cell.Value
        End If
    Next cell
    oFile.writeline strLine
    oFile.Close
    Set fso = Nothing
    Set oFile = Nothing
End Sub

I've tested it and it seems to handle things well. Give it a go.

 

[spycein]

Dear @kennypete,
Thank you so much for your help.
But i am getting the following errors
1) Run time error 9 : Subscript out of range
2) Run time error 1004 : Method "Range of object_ Global failed
Both in the same line if i try the code in two different workbooks using same code with same data.
Kindly advice.
Best Regards,
Shib

 

[kennypete]

Hi @spycein

Error 1004 will occur if you have only one cell selected. Is that the case? Note that I read "specified column range" as meaning you wanted to select the range you want to send to the .txt file, so if you were expecting it to ask for a range, that's not how it works, but it could be changed easily to do that.

I also just realised that I should have used Long rather than Integer for intRows (though it does not cause an error, Run time error 6, except if you have >32k rows in your used range). You can change that if need be by replacing that "As Integer" to "As Long".

I cannot replicate Run time error 9. It is possible it relates to your Excel version. You should include that in your profile too by the way otherwise people may presume you have a version that can do things that yours can't. E.g. mine:

Try it again, selecting a range. I tried it also on a big range (over 1 million rows, 2 columns of data) and it worked fine (after the change from Integer to Long). Here it is working below on a small range:

 

[Fluff]

I cannot replicate Run time error 9. It is possible it relates to your Excel version.

You will get that error, if only one cell is selected, or if there is no sheet codenamed Sheet1.
Also if the activesheet is not codename sheet1, you could get some problems.

 

[Fluff]

Correction to my previous post.
You will get that error, if there is no sheet codenamed Sheet1, or sheet codename sheet1 is blank.

 

[spycein]

Hi @spycein

Error 1004 will occur if you have only one cell selected. Is that the case? Note that I read "specified column range" as meaning you wanted to select the range you want to send to the .txt file, so if you were expecting it to ask for a range, that's not how it works, but it could be changed easily to do that.

I also just realised that I should have used Long rather than Integer for intRows (though it does not cause an error, Run time error 6, except if you have >32k rows in your used range). You can change that if need be by replacing that "As Integer" to "As Long".

I cannot replicate Run time error 9. It is possible it relates to your Excel version. You should include that in your profile too by the way otherwise people may presume you have a version that can do things that yours can't. E.g. mine:

View attachment 11880​

Try it again, selecting a range. I tried it also on a big range (over 1 million rows, 2 columns of data) and it worked fine (after the change from Integer to Long). Here it is working below on a small range:

View attachment 11879

Thank you so much @kennypete for the insight.
Did not select the range earlier. Now its work fine.
Just wanted to if it is possible to save the file in xml format and also to add prefix text and suffix text into the range on the saved file. Should be encoded in VBA code.
Many many thanks.
Best Regards,
Shib

 

[spycein]

Thank you so much @kennypete for the insight.
Did not select the range earlier. Now its work fine.
Just wanted to if it is possible to save the file in xml format and also to add prefix text and suffix text into the range on the saved file. Should be encoded in VBA code.
Many many thanks.
Best Regards,
Shib

Dear @kennypete,
I realised that if data range sheet is not active then the code does not work.
For example, i kept my data range in Sheet1 as mentioned by you. It works fine if i run the macro from sheet1.
But it does not work if i am on any other sheet. My objective is to create a command button in a separate sheet and assign/run the macro with that button.
Hope i explained my issue properly. I also wanted know if i could use a dynamic named range as range.
Thanks again.
Best Regards
Shib

 

[Fluff]

Change every occurrence of Sheet1 to ActiveSheet

 

[kennypete]

Here it is with the suggested improvements @Fluff rightly pointed out, Long correction v. Integer, and output as XML (well, XHTML, but that's still XML and you did not say what you were after). Open the output in any browser. "Prefix" text and "Suffix" text has been added to paras prior to and following the table.

If only one cell is selected it now asks for the range you want to run it on. That could easily be adjusted, of course, to also change to a different sheet, though I have not added that. I think you have enough here to complete specifically what you're wanting to do.

Option Explicit
Sub SaveTXTselection()
    
    Dim strLine As String
    Dim strChosenRange As String
    Dim lngRow As Long
    Dim booFirstCell As Boolean
    If Selection.Address = "$1:$1048576" Then Range(ActiveSheet.UsedRange.Address).Select ' if the whole sheet is selected then reduce it to the used range
    If Selection.Count = 1 Then
        ' If only one cell, then ask for the range wanted
        strChosenRange = InputBox("Enter a range to save as XML in the form A1:B2", "XML extract")
        Range(Split(strChosenRange, ":")(0), Split(strChosenRange, ":")(1)).Select
    ElseIf UBound(Split(Selection.Address, "$")) = 2 Then
    ' whole column(s) or whole row(s) selected so we need to limit the output to the used range within the columns or rows
        If IsNumeric(Split(Split(Selection.Address, "$")(1), ":")(0)) Then
            ' whole row(s), so re-select to column A plus the extent of the used range's columns since the rest is empty
            Range("A" & Split(Selection.Address, "$")(1) & Split(ActiveSheet.UsedRange.Address, "$")(3) & Split(Selection.Address, "$")(2)).Select
        Else
            ' whole column(s), so re-select row 1 plus the extent of the used range's rows since the rest is empty
            Range(Split(Split(Selection.Address, "$")(1), ":")(0) & "1:" & Split(Selection.Address, "$")(2) & Split(ActiveSheet.UsedRange.Address, "$")(4)).Select
        End If
    End If
    lngRow = Split(Split(Selection.Address, "$")(2), ":")(0)
    booFirstCell = True
    
    Dim varSaveAsTxt As Variant
    ' displays the save file dialog (file name only required, the .txt will be added)
    varSaveAsTxt = Application.GetSaveAsFilename(FileFilter:="XML (XML Data) (*.xml), *.xml")
    ' check to make sure the user hasn't pressed cancel
    If varSaveAsTxt = False Then Exit Sub
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim oFile As Object
    Set oFile = fso.CreateTextFile(varSaveAsTxt)
    Dim cell As Object
    
    oFile.writeline "<?xml version=""1.0"" encoding=""UTF-8""?>"
    oFile.writeline "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">"
    oFile.writeline "<html xmlns=""http://www.w3.org/1999/xhtml"">"
    oFile.writeline "<head><title>" & varSaveAsTxt & "</title></head>"
    oFile.writeline "<body>"
    oFile.writeline "<p>Prefix</p>"
    oFile.writeline "<table frame=""box""  rules=""all"">"
    
    ' Go through each selected cell and write it
    For Each cell In Selection
        If Split(cell.Address, "$")(2) > lngRow Then
            oFile.writeline "<tr>" & strLine & "</tr>"
            lngRow = lngRow + 1
            strLine = "<td>" & cell.Value & "</td>"
        ElseIf booFirstCell Then
            strLine = "<td>" & cell.Value & "</td>"
            booFirstCell = False
        Else
            strLine = strLine & "<td>" & cell.Value & "</td>"
        End If
    Next cell
    oFile.writeline "<tr>" & strLine & "</tr>"
    oFile.writeline "</table>"
    oFile.writeline "<p>Suffix</p>"
    oFile.writeline "</body>"
    oFile.writeline "</html>"
    oFile.Close
    Set fso = Nothing
    Set oFile = Nothing
End Sub