View Full Version : Solved: Create a Text File
qcoleman
12-22-2011, 02:26 PM
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
12-22-2011, 05:08 PM
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
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
12-23-2011, 05:44 AM
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
12-23-2011, 08:08 AM
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
12-23-2011, 09:11 AM
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
12-24-2011, 11:19 AM
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
12-24-2011, 12:57 PM
Thanks! This worked out great.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.