Code Efficiency Suggestions

[JMB]

FYI - when you are deleting rows, I believe it is faster to create one range
variable that represents the rows you want to delete (using the Union
method), then delete the range (containing all of your rows you want deleted)
at the end of your loops instead of deleting them as you go. This also
avoids the problem with the rows moving as you delete them. That way you are
deleting one range object instead of possibly hundreds.

I'm not saying this is a better route than what others are suggesting, it is
only informational.

Excel can change variables stored internally faster than it can go and do
"something" with a worksheet (such as delete rows).

View this thread: http://www.excelforum.com/showthread.php?threadid=377607

For those who are following this thread, one proceedure taking such a long
time was the deleting of the rows. Meaning, I wanted to delete the row if
the cell in column A was blank. This took about 5 minutes, however, when I
sorted on column A first then ran the exact code, it took 3 seconds. Here
is the modified 'DeleteRows' code...

Sub DeleteRows()

With Columns("A:N")
.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

I have text file that I'm importing and extracting data from...the import
code I'm using imports 1 line at a time then parses the data. Part of that
code stops the importation at around 65000 rows and starts on a new tab.
Then for each tab I have a series of formulas that extract the perinent
data. I then do a filter to delete the rows i don't want. And finally, I
determine the size of each of the tabs other than the first tab and store
the values in an array and put the data on the first tab. This whole
process takes about 22 min and was wondering if anyone else had any good
ideas as to speeding up the code. Always looking for a faster way Here
is the main code to paste the formulas and delete the rows I don't want and
copy the values to the first sheet.


Sub PutInForumulas()
ts = Time
Application.ScreenUpdating = False


cnta = Worksheets.Count
For z = 1 To cnta - 1
Worksheets(z).Select
Application.StatusBar = "Scrubbing Worksheet " & z
Columns("A:N").Select
Selection.Insert Shift:=xlToRight

Rows("1:1").Insert Shift:=xlDown
Sheets(z).[A1].FormulaR1C1 = "StatementDte"
Sheets(z).[B1].FormulaR1C1 = "COAS"
Sheets(z).[C1].FormulaR1C1 = "OrgNum"
Sheets(z).[D1].FormulaR1C1 = "Fund"
Sheets(z).[E1].FormulaR1C1 = "TransDte"
Sheets(z).[F1].FormulaR1C1 = "TransType"
Sheets(z).[G1].FormulaR1C1 = "DocNum"
Sheets(z).[H1].FormulaR1C1 = "RefNum"
Sheets(z).[I1].FormulaR1C1 = "AcctNum"
Sheets(z).[J1].FormulaR1C1 = "BudgetActivity"
Sheets(z).[K1].FormulaR1C1 = "TransActivity"
Sheets(z).[L1].FormulaR1C1 = "EncumActivity"
Sheets(z).[M1].FormulaR1C1 = "CMType"
Sheets(z).[N1].FormulaR1C1 = "TransDesc"



Range("N2").End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.End(xlUp).Select
rw = ActiveCell.Row

For i = 2 To rw

'Range("A" & i).FormulaR1C1 =
"=IF(RC[4]<>"""",TEXT(RC[4]*1,""yyyymm""),"""")"
Range("B" & i).FormulaR1C1 = _
"=IF(LEFT(TRIM(RC[13]),5)=""COAS:"",TRIM(MID(RC[13],6,4)),R[-1]C)"
Range("C" & i).FormulaR1C1 = _
"=IF(LEFT(TRIM(RC[12]),4)=""ORG:"",TRIM(MID(RC[12],5,8)),R[-1]C)"
Range("D" & i).FormulaR1C1 = _

"=IF(RIGHT(TRIM(RC[11]),4)=""FUND"",TRIM(RIGHT(TRIM(OFFSET(RC[11],2,,)),7)),R[-1]C)"
Range("E" & i).FormulaR1C1 = _

"=IF(LEFT(TRIM(RC[10]),1)=CHAR(12),"""",TRIM(IF(isdate(LEFT(TRIM(RC[10]),10)),LEFT(TRIM(RC[10]),10),"""")))"
Range("F" & i).FormulaR1C1 = _
"=TRIM(IF(RC[-1]<>"""",MID(TRIM(RC[9]),LEN(RC[-1])+1,5),""""))"
Range("G" & i).FormulaR1C1 = _

"=TRIM(IF(RC[-1]<>"""",MID(TRIM(RC[8]),LEN(RC[-2])+LEN(RC[-1])+2,9),""""))"
Range("H" & i).FormulaR1C1 = _

"=IF(ISNUMBER(VALUE(TRIM(IF(RC[-2]<>"""",MID(TRIM(RC[7]),LEN(RC[-3])+LEN(RC[-2])+LEN(RC[-1])+3,8),"""")))),TRIM(IF(RC[-2]<>"""",MID(TRIM(RC[7]),LEN(RC[-3])+LEN(RC[-2])+LEN(RC[-1])+3,8),"""")),"""")"
Range("I" & i).FormulaR1C1 =
"=TRIM(IF(RC[-4]<>"""",RIGHT(TRIM(RC[6]),6),""""))"
Range("J" & i).FormulaR1C1 = "=IF(RC5<>"""",TRIM(RC[5]),"""")"
Range("K" & i).FormulaR1C1 = "=IF(RC5<>"""",TRIM(RC[6]),"""")"
Range("L" & i).FormulaR1C1 = "=IF(RC5<>"""",TRIM(RC[6]),"""")"
Range("M" & i).FormulaR1C1 = "=IF(RC5<>"""",TRIM(RC[6]),"""")"
Range("N" & i).FormulaR1C1 = _

"=IF(RC[-7]<>"""",RIGHT(TRIM(RC[1]),LEN(TRIM(RC[1]))-VALUE(FIND(TRIM(RC[-7]),RC[1],1)+LEN(RC[-7])-1)),"""")"


With Rows(i & ":" & i)
.Value = .Value
End With

Next i
With Range("A2:A" & rw)
.FormulaR1C1 = "=IF(RC[4]<>"""",TEXT(RC[4]*1,""yyyymm""),"""")"
End With


DeleteRows

Next z


Copyworksheets
Application.ScreenUpdating = True
te = Time
MsgBox "Elapsed time: " & Format(te - ts, "hh:mm:ss")

Sub Copyworksheets()
Dim vArray As Variant
cnta = Worksheets.Count

For q = 2 To cnta - 1

Worksheets(q).Select
'Range("A1").CurrentRegion.Copy

vArray = Range("A1").CurrentRegion.Value
rw1 = Range("A1").End(xlDown).Row
'cl1 = Chr$(Range("IV1").End(xlToLeft).Column + 64)
' vArray = Range("A1:" & cl & rw).Value

rw = Sheets(1).Range("A1").End(xlDown).Row + 1
cl = Chr$(Sheets(1).Range("IV1").End(xlToLeft).Column + 64)

Sheets(1).Select

Sheets(1).Range("A" & rw & ":" & cl & rw + rw1 - 1).Value = vArray
Columns("O:R").Delete
Next q

Sheets(1).[A1].FormulaR1C1 = "StatementDte"
Sheets(1).[B1].FormulaR1C1 = "COAS"
Sheets(1).[C1].FormulaR1C1 = "OrgNum"
Sheets(1).[D1].FormulaR1C1 = "Fund"
Sheets(1).[E1].FormulaR1C1 = "TransDte"
Sheets(1).[F1].FormulaR1C1 = "TransType"
Sheets(1).[G1].FormulaR1C1 = "DocNum"
Sheets(1).[H1].FormulaR1C1 = "RefNum"
Sheets(1).[I1].FormulaR1C1 = "AcctNum"
Sheets(1).[J1].FormulaR1C1 = "BudgetActivity"
Sheets(1).[K1].FormulaR1C1 = "TransActivity"
Sheets(1).[L1].FormulaR1C1 = "EncumActivity"
Sheets(1).[M1].FormulaR1C1 = "CMType"
Sheets(1).[N1].FormulaR1C1 = "TransDesc"

End Sub


Sub DeleteRows()
Dim lLastRow As Long 'Last row
Dim Rng As Range
Application.StatusBar = "Deleting Rows on Sheet " & z
Application.ScreenUpdating = False

With ActiveSheet
.UsedRange 'Reset Last Cell
'Determine last row
lLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set Rng = Range("A1", Cells(lLastRow, "O"))
' Filter the column to show only the data to be deleted
Rng.AutoFilter Field:=1, Criteria1:=""
' Delete the visible cells
Rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.UsedRange 'Reset the last cell
End With

End Sub

 

[Nick Hebb]

Does the forumula order in the original post for columns A-N match the
order you listed above? The Column N formula doesn't seem to match the
last field description (TransDesc).

 

[Job]

I'm sorry Nick, it's been a long day/night.

TransDesc - - Text - Refers to the First 'column'. Is dependent upon the
location of [DocNum] in the first columns string. I find the value of
DocNum + the len(DocNum) and grab everything to the right of the DocNum
which is the TransDesc.

Thanks again for all your help!

 

[Nick Hebb]

This is a really long reply, so I'll break it into several parts in
case there's a length restriction for these posts.

Part 1:

Now that I've looked at it, I definitely wouldn't do any of this in
Excel. It could be done pretty easily in Access. [I know it's

frustrating when people say "easy", but hopefully what follows will be
"easy" to follow]. Here's what I would do:

1. In Access, create and save a table called tmpImportData and give it
5 text fields, name them Col1 - Col5.

2. From the file menu, select Get External Data > Import. An import
dialog box will open (essentially it's the same as a file open dialog

box). Change the file types to text, locate your raw data file, select
it, and click Import.

3. The Import text wizard will pop up. Click Advanced and set the field
names to Col1 - Col5, and click the skip checkbox second field since

you don't seem to use it. Then click the Save As button and give it a
Specification Name.

4. Finish the wizard, telling it to add the data to an existing table -
select tmpInputData.

5. Next, create a query in design view. I'll call it
qryCleanInputData. switch to SQL view and paste the following:

DELETE Left([tmpInputData]![Col1],1)=Chr(12) Or Not
IsDate(Left([tmpInputData]![Col1],10)) AS InvalidDate
FROM tmpInputData
WHERE (((Left([tmpInputData]![Col1],1)=Chr(12) Or Not
IsDate(Left([tmpInputData]![Col1],10)))=True));

{Note the change from char(12) to chr(12)}

6. Run the query to clean your data.

 

[Nick Hebb]

part II:


The following 2 steps could be done as a single step, but to make it
simple we'll split the tasks.

7. Create another query in design view. At the Show Table prompt
select tmpInputdata and click the add button. This query is where all
the

hard work comes. Save the query as qryMakeParsedInputDataTable.
Looking at all the formulas you had listed in your original post, at
least

half of the formula content was conditional logic based on invalid data
that we just stripped out in qryCleanInputData. Here's a breakdown

of what you need to do (you may want to do a lot of this off-line in a
text editor):

a. Replace the target ranges with the name you want for each column
followed by a ":", as the following example shows:

'Range("A" & i).FormulaR1C1 =
"=IF(RC[4]<>"""",TEXT(RC[4]*1,""yyyymm""),"""")"

Becomes

StatementDte:=IF(RC[4]<>"""",TEXT(RC[4]*1,""yyyymm""),"""")

b. Remove all the conditional logic in your formulas that depended upon
whether TransDte was invalid, since the query we created cleans that

up. So TransDte becomes:

TransDte:=TRIM(LEFT(TRIM(RC[10]),10))

c. Replace the references to cells with Col1 - Col5 references. The
references are in the format TABLE_NAME![FIELD_NAME], so TransDte now

becomes

TransDte:=TRIM(LEFT(TRIM(tmpInputData![Col1]),10)

d. Replace any other cell references that refer to newly created
columns to their new field names. So COAS becomes
COAS:=IF(LEFT(TRIM(tmpInputData![Col1]),5)="COAS:",TRIM(MID(tmpInputData![Col1],6,4)),[StatementDte])

{note the new reference to StatementDte}

e. Replace all your Excel functions with Access equivalents. The only
2 I see are:
- TEXT([TransDte], "yyymm") becomes Format$([TransDte], "yyyymm")
{Note, I've changed the Cell reference to the column name that will
be created in this query}
- IF(condition, true, false) becomes Iif(condition, true, false) {note
the extra "i" in "Iif"}.

f. Replace any remaining """"'s with "" if there are any.

g. At this point you should have a formula that matches every column in
the table. Take each formula and paste it into a separate field in

the query. In the query editor, select query from the menu and select
make table Query. Give the new table the name tmpParsedInputData.

h. Save the query and close it. Then run it by double-clicking on it.

i. Open the resulting table and check the contents. If it doesn't look
right, go back and check your formulas in the query.

 

[Nick Hebb]

Part II:


8. Create another query and select tmpParsedInputData in the Show table
dialog. Select all the fields from tmpParsedInputData and drag them

into the fields area. Go to Query on the menu and change the type to
Append query and select your target table as the table to append to.

Access should automatically figure out which fields append append
where, but you'll want to double check. Save the query as

qryAppendParsedInputData.

9. At this point you're ready to run the append query, but you should
be extra cautious. It's really easy to screw up data in a flash with

databases, so you should test everything first. I would make a copy of
the original target table and change the target table in the append

query to the copy. Run the append table and check the effect on the
data. Then I would import the data into the original table using your

traditional method. Then, create a find unmatched query using the
query wizard and verify that all the records created with the new
method

match the records created with the old method. If it all works, change
the target table in the append query back to the original target

table (instead of the copy).

10. Create a new query and save it as qryDeleteInputData. In SQL view
paste the folowing:

DELETE tmpInputData.Col1
FROM tmpInputData
WHERE (((tmpInputData.Col1) Like "*"));

11. Go to the macro screen and create a new macro. Add the following
Actions
- OpenQuery (query name = qryDeleteInputData)
- DeleteObject (type = table, name = tmpParsedInputData)
- TransferText (specification name = to the one you saved earlier, file
name = your source file, table name = tmpInputData)
- OpenQuery (query name = qryCleanInputData)
- OpenQuery (query name = qryMakeParsedInputDataTable)
- OpenQuery (query name = qryAppendParsedInputData)
- DeleteObject (type = table, name = tmpParsedInputData) ' run again to
clean up
- OpenQuery (query name = qryDeleteInputData) ' run again to clean up

You might also want to Repair and Compact the database since theiur was
a lot of data created and deleted:
- RunCommand (command = RepairDatabase)
- RunCommand (command = CompactDatabase)

Save the macro and you're set.

 

[Nick Hebb]

Note, the posts were submitted in order, but show up out of order.
also, the "Part II" that starts with step 8 should be Part III.

 

[Job]

Nick Thanks for the Code! I have a question, when determining the 'Fund' in
Excel I have to use an offset as it is two lines below and it doesn't tell
the fund on the actual line of the fund number. When we clean the
irrelevant lines of code, we now no longer know where the fund is..for
example in the clean column you'll see something like "This is the fund
description ZO09876" the "This is the fund description" can be anything so
it would be difficult to key off of any type of text there. If you just set
the column to extract the last word in that column, you'd also get all kinds
of other data as that column contains most of the relevant data. Any
thoughts?

 

[Nick Hebb]

Create another make table query, and go into SQL View and paste the
following:

SELECT tmpInputData.ID, tmpInputData.Col1, tmpInputData.Col2,
tmpInputData.Col3, tmpInputData.Col4, tmpInputData.Col5,
tmpInputData_1.Col1 AS Fund
FROM tmpInputData LEFT JOIN tmpInputData AS tmpInputData_1 on
tmpInputData.ID = tmpInputData_1.ID +2

This query grabs Col1 from the row 2 rows down. Because the syntax
isn't Query Designer friendly, you won't be able to create or view the
design in Design view and will get a message box telling you so.

Add an OpenQuery step to your macro - before the qryCleanInputData.
You will also need to base all your other queries off of the table
created here (whatever you decide to name it). Also, I would create
DeleteObject macro steps to remove this table after your operation is
complete.

 

[Job]

Nick,

I failed to post my thanks for all your help! It helped tremenously and
opened my eyes to new possibilities regarding text streaming.

Thanks again for all the work!

Cheers,

Job

 

[Nick Hebb]

No problem. Sometimes I have this skewed sensibility that makes it more
fun to work on other people's problems than my own!

By the way, did you get this to work? If so, how much did you cut the
import time by? Just curious.

--Nick

 

[crazybass2]

Job,

I will preface this post with the admission that I have not read all 31
posts in their entirety, so pardon if I repeat some advice that you’ve
already received.

I have a similar application in which I access several text files and import
data into Excel. I initially started by importing the entire file and then
deleting the lines I didn’t need. My suggestion is similar to Nick’s
suggestion about ‘scrubbing’ the data and dumping the needed data into a new
text file. You can do the same but put it in Excel.

In the code below I read a file and only import the lines that I want and if
I reach 65400 (I leave a little padding for another reason) I move the active
cell to the first row of the next column. Since all the data I am importing
is never seen by the user (data within each line is extracted) I am not
concerned with the format of the cells. This cuts down on the number of tabs
I create as well as the process time.

One file was 500,000+ lines. Reading each line in and then deleting
unneeded lines took upwards of 30 minutes. When I only import the lines I
need the same file took 20 seconds to process. Now I have an application in
which I must read in several different text files each with several thousand
lines and the 20 seconds each seems like an eternity….I guess it just goes to
show you, faster is never fast enough.

Here’s the code: (I have left out variable declaration and the like to
conserve space)

Sub GetData()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.StatusBar = "Retrieving file"
Filename = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If Filename = "False" Then End
Application.Cursor = xlWait
filenum = FreeFile()
Open Filename For Input As #filenum
Sheet1.Cells(1, 1).Select
Do While Seek(filenum) <= LOF(filenum)
Line Input #filenum, ResultStr
readline = LTrim(ResultStr)
If InStr(1, readline, "TEXT_TO_FIND-1") > 0 Then
importline = True
ElseIf InStr(1, readline, "TEXT_TO_FIND-2") > 0 Then
importline = True
Else
importline = False
End If
If importline Then
Application.StatusBar = "Importing Row " & counter & " of " & Filename
ActiveCell.Value = readline
If ActiveCell.Row = 65400 Then
ColCounter = ColCounter + 1
Sheet1.Cells(1, ColCounter).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Else
Application.StatusBar = "Reading Row " & counter & " of " & Filename
End If
importline = False
counter = counter + 1
Loop
Close
Application.Cursor = xlDefault
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


The if conditions can change to suit the data you are looking to import. If
it is a certain string that you are looking for, just replace
"TEXT_TO_FIND-1" with your string. Hope this is of some help.

Mike

 

[Job]

Hi Nick,

I did get it to work. It cut the time down to about 4 minutes. This is a
huge improvement over the orignal 30+ minutes.

Cheers!

 

[Job]

Hi Mike,

Thanks for the post. You hit it straight on. This is similar to what I'm
using other that the fact that the if's are very complex and I'm putting it
into Access instead of Excel.

Cheers!
Job