PDA

View Full Version : Solved: Modifying "Saving Range to a Text File" Code - Thanks to mvidas!



jdubya
11-17-2006, 10:02 AM
I'm posting Matt's answer to me in a response from a private message I sent to him concerning some code he posted in a previous thread on the board (Sorry, can't post the link. Don't have 5 posts yet). Hopefully, others can get some use from it. Thanks again Matt. It works great!

Hi Matt,

I saw some of your code posted on how to save a range to a text file.

It works real nice. However, is there a way to modify it to where it would save columns A and B, columns A and C, columns A and D, and so forth, to separate text files?

Thanks,

Jon

Hi Jon,

Here are two functions, one shows what I'm doing to get two different columns (A and C), the other loops from B to the last used column, and saves A and each column to a separate text file (saving it with "A and _" in the filename too):

Sub SaveAsTextFile()
Dim URArr() As Variant, i As Long, j As Long, vFF As Long, ExpArr() As String
Dim URange As Range, vDelim As String
vDelim = Chr$(9) 'delimiter variable, here is tab character
Set URange = ActiveSheet.UsedRange
Set URange = Range(Cells(URange.Row, 1), URange.Cells(URange.Rows.Count, _
URange.Columns.Count)) 'make sure it starts from column A, just in case
URArr = URange.Value
ReDim ExpArr(1 To UBound(URArr, 1))
For i = 1 To UBound(URArr, 1) 'loop through rows in usedrange
ExpArr(i) = URArr(i, 1) & vDelim & URArr(i, 3) 'columns 1 and 3, A and C
Next 'i
vFF = FreeFile
Open "C:\" & Format(Date, "ddmmyy") & ".txt" For Output As #vFF
For i = 1 To UBound(ExpArr)
Print #vFF, ExpArr(i)
Next 'i
Close #vFF
Set URange = Nothing
MsgBox "File Saved"
End Sub
Sub SaveSuccessiveColumnsAsTextFile()
Dim URArr() As Variant, i As Long, j As Long, vFF As Long, ExpArr() As String
Dim URange As Range, vDelim As String, vFile As String
vDelim = Chr$(9) 'delimiter variable, here is tab character
Set URange = ActiveSheet.UsedRange
Set URange = Range(Cells(URange.Row, 1), URange.Cells(URange.Rows.Count, _
URange.Columns.Count)) 'make sure it starts from column A, just in case
URArr = URange.Value
For j = 2 To UBound(URArr, 2) 'go through each column starting at B
ReDim ExpArr(1 To UBound(URArr, 1))
For i = 1 To UBound(URArr, 1) 'loop through rows in usedrange
ExpArr(i) = URArr(i, 1) & vDelim & URArr(i, j) 'columns 1 and j
Next 'i
vFF = FreeFile
vFile = "C:\" & Format(Date, "ddmmyy") & " A and " & Left(Cells(1, j).Address _
(1, 0), InStr(1, Cells(1, j).Address(1, 0), "$") - 1) & ".txt"
Open vFile For Output As #vFF
For i = 1 To UBound(ExpArr)
Print #vFF, ExpArr(i)
Next 'i
Close #vFF
Next 'j
Set URange = Nothing
MsgBox "File Saved"
End Sub
Please let me know if you have questions!
Matt