Solved: Create a Text File

[qcoleman]

I have this code that I creates a txt file from a dynamic identifier (i.e. word) that should copy a dynamic range of cells into a new workbook and create a txt file. I can’t seem to get this code to run properly. I get an error that says “Pastespecial method of Range class failed”. Not sure at all on how to fix this.


Sub Create_txt_file()

Dim ws As Worksheet
Dim newwb As Workbook
Dim newws As Worksheet
Dim fname As String
Dim cell As Range
Dim LastRow As Long
Dim Sorting As Range

Set ws = ActiveSheet
Set newwb = Application.Workbooks.Add
Set newws = newwb.Sheets.Add

'Find the last used row in a column with Part in the Header of that column
On Error Resume Next
Set cell = Rows(4).Find("*Part*")
On Error GoTo 0
If Not cell Is Nothing Then

LastRow = Cells(Rows.Count, cell.Column).End(xlUp).Row
Range("A5", cell(LastRow - 3, cell.Column)).Copy

End If

newws.Range("A1").PasteSpecial xlPasteAll
Application.CutCopyMode = False

fname = Application.GetSaveAsFilename

If Right(fname, 4) = ".txt" Then
fname = fname
Else
fname = fname & "txt"
End If

Application.DisplayAlerts = False
newwb.SaveAs fname, xlText
Application.DisplayAlerts = True

End Sub

[mdmackillop]

Your basic problem is that without references, you are searching the newly created workbook, not WS

Move these lines of code below first End If
''....
End If

Set newwb = Application.Workbooks.Add
Set newws = newwb.Sheets.Add

[GTO]

Greetings,

See if this helps:


Sub Create_txt_file()

Dim ws As Worksheet
Dim newwb As Workbook
Dim newws As Worksheet
Dim fname As String
Dim cell As Range
Dim LastRow As Long
Dim Sorting As Range

Set ws = ActiveSheet
Set newwb = Application.Workbooks.Add(xlWBATWorksheet)
Set newws = newwb.Worksheets(1) ' newwb.Sheets.Add

'Find the last used row in a column with Part in the Header of that column
'On Error Resume Next
'// Qualify Cells(), Range(), Rows() to ensure we work against the worksheet we //
'// want to. Elsewise, we just end up trying to .Find a value on the //
'// ActiveSheet, which is now the ActiveSheet in the new/blank workbook that we //
'// just created above. //
Set cell = ws.Rows(4).Find("*Part*")
'On Error GoTo 0

If Not cell Is Nothing Then
LastRow = ws.Cells(ws.Rows.Count, cell.Column).End(xlUp).Row
ws.Range(ws.Range("A5"), ws.Cells(LastRow - 3, cell.Column)).Copy

'// I would probably wait to create the new file until after ensuring .Find //
'// returned a cell (Range), but at minimum, I think we want to include the //
'// Paste in the IF; so in case there's nothing to paste, we skip by //
'// harmlessly. //
newws.Range("A1").PasteSpecial xlPasteAll
Application.CutCopyMode = False

fname = Application.GetSaveAsFilename

If Right(fname, 4) = ".txt" Then
fname = fname
Else
fname = fname & "txt"
End If

Application.DisplayAlerts = False
newwb.SaveAs fname, xlText
Application.DisplayAlerts = True
Else
'// If nothing is returned from .Find, ditch the new wb. //
newwb.Close False
End If

End Sub

[qcoleman]

Thanks GTO! Would code works well, but what would i change in this part of the code to make it dynamic. Right now it copies everything from column A to whatever column that the word "Part" is found in.

ws.Range(ws.Range("A5"), ws.Cells(LastRow - 3, cell.Column)).Copy

Would the code look something like this

ws.Range(ws.Cells(5,cell.column), ws.Cells(LastRow - 3, cell.Column)).Copy

[qcoleman]

I got it to work with some minor adjustments. Thanks to both of you!

Sub Create_txt_file()

Dim ws As Worksheet
Dim newwb As Workbook
Dim newws As Worksheet
Dim fname As String
Dim cell As Range
Dim LastRow As Long
Dim Sorting As Range

Set ws = ActiveSheet
Set newwb = Application.Workbooks.Add(xlWBATWorksheet)
Set newws = newwb.Worksheets(1) ' newwb.Sheets.Add

'Find the last used row in a column with Part in the Header of that column
'On Error Resume Next
'// Qualify Cells(), Range(), Rows() to ensure we work against the worksheet we //
'// want to. Elsewise, we just end up trying to .Find a value on the //
'// ActiveSheet, which is now the ActiveSheet in the new/blank workbook that we //
'// just created above. //
Set cell = ws.Rows(4).Find("*Part*")
'On Error GoTo 0

If Not cell Is Nothing Then
LastRow = ws.Cells(ws.Rows.Count, cell.Column).End(xlUp).Row
ws.Range(ws.Cells(5, cell.Column), ws.Cells(LastRow, cell.Column)).Copy
'ws.Range(ws.Range("A5"), ws.Cells(LastRow - 3, cell.Column)).Copy

'// I would probably wait to create the new file until after ensuring .Find //
'// returned a cell (Range), but at minimum, I think we want to include the //
'// Paste in the IF; so in case there's nothing to paste, we skip by //
'// harmlessly. //
newws.Range("A1").PasteSpecial xlPasteAll
Application.CutCopyMode = False

fname = Application.GetSaveAsFilename

If Right(fname, 4) = ".txt" Then
fname = fname
Else
fname = fname & "txt"
End If

Application.DisplayAlerts = False
newwb.SaveAs fname, xlText
Application.DisplayAlerts = True
Else
'// If nothing is returned from .Find, ditch the new wb. //
newwb.Close False
End If

End Sub


:bow:

[qcoleman]

Is there any way to add an Or statement to this code, basically to say find "Part" or "Catalog" in row 4?

Set cell = ws.Rows(4).Find("*Part*")

[mdmackillop]

You need to change the Find criteria. Simplest is to put these in an array and loop through the options


Dim arr, a
arr = Array("Part", "Catalog")
For Each a In arr
Set cell = ws.Rows(4).Find("*" & a & "*")
'your code
Next

[qcoleman]

Thanks! This worked out great.