I have a few questions.
What version of Excel are you using?
You said in step 6, you "cut" the records that AG is null
did you really man "cut", as in: removed from sheet1?
also, you're writing a file with :
a.WriteLine s1 & s2 & s3 & s4 & s5 & s6
but the values have no spaces or delimiters between them.
I think I can do the entire process with a single macro:
In my test data, it processed 65,536 records of 74 columns
in 8 minutes, 32 seconds.
'-------------------------------------------------------------------------
Option Explicit
Sub CvtTotext()
Dim LastRow, LastCol
Dim R, C, RowNI
Dim FileName, FilePath, fs, f, StrOut, StrDelim
Dim TElapsed, TMin, TSec, TStart, TStop
'------------------------------------------
TStart = Timer
Application.ScreenUpdating = False
'------------------------------------------
' Create "Not Imported" sheet
'------------------------------------------
On Error Resume Next
Application.DisplayAlerts = False
Err.Clear
Sheets("Not Imported").Select
If (Err.Number = 0) Then Sheets("Not Imported").Delete
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Not Imported"
On Error GoTo 0
Application.DisplayAlerts = True
'------------------------------------------
Sheets("sheet1").Select
LastRow = ActiveCell.SpecialCells(xlLastCell).Row
LastCol = ActiveCell.SpecialCells(xlLastCell).Column
For C = 1 To LastCol
Sheets("Not Imported").Cells(1, C) = ActiveSheet.Cells(1, C).Value
Next C
FileName = InputBox(" Enter Text File Name ", "Text File")
FilePath = "g:\Treas\Erick\Price File Test\" & FileName & ".txt"
StrDelim = "|"
Set fs = CreateObject("Scripting.FileSystemObject")
If (fs.fileexists(FilePath)) Then fs.deletefile FilePath
Set f = fs.CreateTextFile(FilePath, True)
Application.StatusBar = "Processing " & LastRow & " records)"
RowNI = 1
For R = 2 To LastRow
If (R Mod 1000 = 0) Then
Application.StatusBar = "Processing " & R & " of " & LastRow
End If
If (ActiveSheet.Range("BM" & R).Value <> ActiveSheet.Range("AE" &
R).Value) Then
RowNI = RowNI + 1
For C = 1 To LastCol
Sheets("Not Imported").Cells(RowNI, C) = ActiveSheet.Cells(R,
C).Value
Next C
Else
StrOut = Cells(R, 32).Value '32
StrOut = StrOut & StrDelim & Cells(R, 3).Value '3
StrOut = StrOut & StrDelim & Format(Cells(R, 20).Value, "mmddyyyy")
'20
StrOut = StrOut & StrDelim & Format(Cells(R, 21).Value * 100000000,
"000000000000#") '21
StrOut = StrOut & StrDelim & " "
StrOut = StrOut & StrDelim & "0000000000000"
StrOut = StrOut & StrDelim & " "
StrOut = StrOut & StrDelim & " "
StrOut = StrOut & StrDelim & " "
StrOut = StrOut & StrDelim & "0000000000"
StrOut = StrOut & StrDelim & Format(Cells(R, 22).Value, "mmddyyyy")
'22
StrOut = StrOut & StrDelim & "BNYM"
StrOut = StrOut & StrDelim & "0000000000000"
StrOut = StrOut & StrDelim & " "
f.Writeline StrOut
End If
Next R
f.Close
'------------------------------------------
Application.StatusBar = False
Application.ScreenUpdating = True
'------------------------------------------
TStop = Timer
TElapsed = TStop - TStart
TMin = TElapsed \ 60
TSec = TElapsed Mod 60
MsgBox "Finished" & Chr(13) & TMin & " min " & TSec & " sec"
'------------------------------------------
End Sub
Paul
________________________________
From: Erick C <boricua2...@gmail.com>
To: MS EXCEL AND VBA MACROS <excel-macros@googlegroups.com>
Sent: Thu, May 20, 2010 11:35:21 AM
Subject: $$Excel-Macros$$ Need macro help - Need to sort, cut and paste
Good morning everybody -
I am still quite a novice when it comes to VB and writing codes, so
any help I can get would be greatly appreciated. I am currently
working on a code that takes data from a xls file that I download and
convert it to a text file. I found an older posting with an example
that I modified a bit to meet my format requirements. The formatting
is working fine, but there is some manual cleanup that has to be done
prior to running the macro that I would like to add to the macro.
What I am trying to add to my current macro (in this order):
1. Sort the file by column 20 ascending (column T)
2. In cell AG2 (column 33), enter formula "=if(T2=E2, "OK","")
3. Copy formula from AG2 down column AG to last record
4. Sort the file by column 33 (column AG)
5. Create a new worksheet named "Not Imported"
6. Back in Sheet 1, cut any record where the AG cell is null and paste
into Not Imported tab
7. Back in sheet 1, continue with the code I have (below):
Public Sub CvtTotext()
LastRow = Cells.Find("*", ActiveCell.SpecialCells(xlLastCell), , ,
xlByRows, xlPrevious).Row
Filename = InputBox(" Enter Text File Name ", "Text File")
FilePath = "g:\Treas\Erick\Price File Test\" & Filename & ".txt"
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(FilePath, True)
For Row = 3 To LastRow
s1 = Cells(Row, 32).Value
s2 = Cells(Row, 3).Value
s3 = Format(Cells(Row, 20).Value, "mmddyyyy")
s4 = Format(Cells(Row, 21).Value * 100000000, "000000000000#")
s5 = " "
s6 = "0000000000000"
s7 = " "
s8 = " "
s9 = " "
s10 = "0000000000"
s11 = Format(Cells(Row, 22).Value, "mmddyyyy")
s12 = "BNYM"
s13 = "0000000000000"
s14 = " "
a.WriteLine s1 & s2 & s3 & s4 & s5 & s6 & s7 & s8 & s9 & s10 &
s11 & s12 & s13 & s14
Next
a.Close
MsgBox FilePath & " Created."
End Sub
If there are existing examples that do something close to what I am
trying to do, I would be more than happy to try to rip them apart
myself, I know everyone is quite busy. Any help I can get would be
greatly appreciated! Thanks!
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 6,800 subscribers worldwide and receive many nice notes about the
learning and support from the group.Let friends and co-workers know they can
subscribe to group at http://groups.google.com/group/excel-macros/subscribe
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 6,800 subscribers worldwide and receive many nice notes about the
learning and support from the group.Let friends and co-workers know they can
subscribe to group at http://groups.google.com/group/excel-macros/subscribe
