Excel Select the Rows - Input Box - Save to Text Files

Folks,:)

Good Saturday.

I wanted to save a selection to text files.

So I use the input box select my rows and it should save them to my text files on my desktop.

So i did some stuff and well - its not happening

Please can a pro help me see why my range doesnt work

Code:

---


 

    Sub SaveSelectedRows()
   

    Dim i As Long
    Dim LastDataRow As Long
    Dim MyFile As String
    Dim fnum
   
   
    Dim UserRange As Range
    'On Error GoTo Canceled
    Set UserRange = Application.InputBox(Prompt:="Please Select Range", Title:="Range Select", Type:=8)
   
   
   
    'LastDataRow = ActiveSheet.Range(UserRange)
   
    'LastDataRow = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
   
    For i = 4 To LastDataRow
   
   
    '--  Text Files Names : Column E
   
    'MyFile = "C:\Users\DJ-PC\Desktop\Text\" & ActiveSheet.Range("E" & i).Value & ".txt"
   
    MyFile = "C:\Users\DJ-PC\Desktop\Text\" & ActiveSheet.Range(UserRange).Value & ".txt"
   
   
    '-- Save Text in Column 10 Cells
    s = NewLn(Cells(i, 10).text) & vbNewLine
   

    fnum = FreeFile
    Open MyFile For Output As fnum
    Print #fnum, s
    Close fnum
    Next i
 
    End Sub
   
   
   
    Private Function NewLn(s As String) As String
    NewLn = Replace(s, vbLf, vbNewLine)
   
    End Function

---

it works normally - but i wanted to use a input box becuase i have to keep changing the code when i need different rows only

Thank you for the help

There's a couple of ways I would do it, and they both need the selection made before the sub (Macro) is run.

Code:

---

Sub SaveSelectedRows()
  'Select only Cells in Column "J"   
    Dim Cel As Range   
       
        MyFile = "C:\Users\DJ-PC\Desktop\Text\" & ActiveSheet.Range(UserRange).Value & ".txt"
       
      For Each Cel In Selection
        '-- Save Text in Column 10 Cells
        s = NewLn(Cel) & vbNewLine
       
        fnum = FreeFile
        Open MyFile For Output As fnum
        Print #fnum, s
        Close fnum
Next Cel
   
End Sub

---

Code:

---

Sub SaveSelectedRows()
  'Select Entire Rows
    Dim Cel As Range
       
        MyFile = "C:\Users\DJ-PC\Desktop\Text\" & ActiveSheet.Range(UserRange).Value & ".txt"
       
      For Each Cel In Selection.Columns(10)
        '-- Save Text in Column 10 Cells
        s = NewLn(Cel) & vbNewLine
       
        fnum = FreeFile
        Open MyFile For Output As fnum
        Print #fnum, s
        Close fnum
Next Cel
   
End Sub

---

To do it with a reminder to select something after running the Macro will require two new subs in addition to one of the above, and changing the name of that one. OK, I combined both the above subs for more flexibility.

Code:

---

Option Explicit

SaveTextEnabled As Boolean

Sub SaveSelectedRows()
  MsgBox "PLease Select the Rows or cells to save"
  SaveTextEnabled = True
End Sub

---

Code:

---


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If SaveTextEnabled Then SaveTexts
End Sub

---

Code:

---

Sub SaveTexts()
  'Select Entire Rows or select Column "J"
 
  SaveTextEnabled = False
 
  Dim Texts As Range
  Dim Cel As Range
   
  MyFile = "C:\Users\DJ-PC\Desktop\Text\" & ActiveSheet.Range(UserRange).Value & ".txt"
 
  If Selection.Columns.Count > 1 Then
    Set Texts = Intersect(Selection, Columns(10))
  Else
    Set Texts = Selection
  End If
       
  For Each Cel In Texts
    s = NewLn(Cel) & vbNewLine
   
    fnum = FreeFile
    Open MyFile For Output As fnum
    Print #fnum, s
    Close fnum
  Next Cel
   
End Sub

---

The original code has some fixed assumptions about the data

1) The file names will always be in column "E"
2) The data to be written will always be in column "J" ( i.e. col 10)
3) The file name is on the same row as the data to be written.

If you are planning on keeping those basic assuptions then this should work.

Code:

---

Sub SaveSelectedRows()
    Dim i As Long, LastDataRow As Long, StartRowNum As Long, EndRowNum As Long
    Dim MyFile As String
    Dim fnum, s
    Dim UserRange As Range

    'On Error GoTo Canceled
    Set UserRange = Application.InputBox(Prompt:="Please Select Range", Title:="Range Select", Type:=8)

    With UserRange
        StartRowNum = .Cells(1, 1).Row
        EndRowNum = .Cells(.Rows.Count).Row
    End With

    LastDataRow = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row

    If EndRowNum < LastDataRow Then
        LastDataRow = EndRowNum
    End If

    For i = StartRowNum To LastDataRow

        '--  Text Files Names : Column E
        MyFile = "C:\Users\DJ-PC\Desktop\Text\" & ActiveSheet.Range("E" & i).Value & ".txt"

        '-- Save Text in Column 10 (Column J) Cells
        s = NewLn(Cells(i, 10).Text) & vbNewLine

        fnum = FreeFile
        Open MyFile For Output As fnum
        Print #fnum, s
        Close fnum
    Next i
End Sub

---

If you want to change those restrictions, for example, specifying another column for filenames, then you'll need to explain more about how you want to change things.

Thank you very much Sam and rlv, it has worked a particular treat!

i am working on using input boxes becuase one time i ended up with 20 scripts for the same macro and that was a bit of a night mare.

So the input box is very useful to me

However onto another inexplicable problem has popped up out of memory i only had 2 sheets in my workbook - better delete some of my handy macros as per my coding style not the most efficient - i cluttered it all up trying to solve this problem :grinhalo:


thank you for the code and great explanations folks and enjoy the great weekend
:beerchug: