Code Efficiency Suggestions

J

Job

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
 
G

Guest

Turn the calculations off at the start and back on at the end of the
procedure...

Sub PutInForumulas()
on error goto ErrorHandler
application.calculation = xlManual

'All of your code

ErrorHandler:
application.Calculation = xlAutomatic
End Sub

Because you have more than 65,536 dependancies the entire spreadhseet is
recalculated each time a calculation is done (not just the dirtied cells).
Check out this site for more info on calculations...

http://www.decisionmodels.com/index.htm

The best way to speed this up however would be to not put the data into
Excel. Put the data in Access or some other database and query or pivot out
what you need.
--
HTH...

Jim Thomlinson


Job said:
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
Click to expand...
 
G

Guest

You can turn off screenupdating
Application.ScreenUpdating = False

Turn off calculation if you don't need it. If you need the workbook
calculated at some point in your code, use "Calculate", "CalculateFull", or I
think you can calculate individual worksheets by preceding the statement with
the sheet name or codename (Sheets(1).Calculate)

application.Calculation = xlCalculationManual

Use With / End With when making multiple references to the same object.

With Sheets(z)
.[A1].FormulaR1C1 = "StatementDte"
.[B1].FormulaR1C1 = "COAS"
End With


Note you don't have to select/activate everything in order to do what you
need.

Range("A1").Select
Selection.Copy

is same as Range("A1").Copy


Don't forget to turn ScreenUpdating and Calculation back on at the end of
your code (although I think Excel turns ScreenUpdating back on automatically).
Application.ScreenUpdating = TRUE
application.Calculation = xlCalculationAutomatic

Also see http://www.microsoft.com/officedev/articles/Opg/013/013.htm



Job said:
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
Click to expand...
 
J

Job

Jim,

Because of the number of calculations/formulas in the worksheet, I thought
it might be faster to do the caculations one line at a time. Do you think
it will be faster to turn the calc off, put in all of the formulas (for
every sheet) then turn the calcs back on? It doesn't have to recalculate
each time a cell is 'dirtied' because at the end of the row being calculated
I include;

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

What do you think?


Jim Thomlinson said:
Turn the calculations off at the start and back on at the end of the
procedure...

Sub PutInForumulas()
on error goto ErrorHandler
application.calculation = xlManual

'All of your code

ErrorHandler:
application.Calculation = xlAutomatic
End Sub

Because you have more than 65,536 dependancies the entire spreadhseet is
recalculated each time a calculation is done (not just the dirtied cells).
Check out this site for more info on calculations...

http://www.decisionmodels.com/index.htm

The best way to speed this up however would be to not put the data into
Excel. Put the data in Access or some other database and query or pivot
out
what you need.
--
HTH...

Jim Thomlinson


Job said:
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
Click to expand...
Click to expand...
 
J

Job

JMB,

Thanks for the heads up on the with/end with. Didn't think about that one.
I've made those changes and thanks for the link....

Cheers!

JMB said:
You can turn off screenupdating
Application.ScreenUpdating = False

Turn off calculation if you don't need it. If you need the workbook
calculated at some point in your code, use "Calculate", "CalculateFull",
or I
think you can calculate individual worksheets by preceding the statement
with
the sheet name or codename (Sheets(1).Calculate)

application.Calculation = xlCalculationManual

Use With / End With when making multiple references to the same object.

With Sheets(z)
.[A1].FormulaR1C1 = "StatementDte"
.[B1].FormulaR1C1 = "COAS"
End With


Note you don't have to select/activate everything in order to do what you
need.

Range("A1").Select
Selection.Copy

is same as Range("A1").Copy


Don't forget to turn ScreenUpdating and Calculation back on at the end of
your code (although I think Excel turns ScreenUpdating back on
automatically).
Application.ScreenUpdating = TRUE
application.Calculation = xlCalculationAutomatic

Also see http://www.microsoft.com/officedev/articles/Opg/013/013.htm



Job said:
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
Click to expand...
Click to expand...
 
G

Guest

welcome. but take jims advice and take a serious look at the calculation.
if your macro does not need any info from your workbook(s) (that require the
workbook to be calculated) in order to run, turn the calc off/on. i think it
makes the biggest dent in run time in the spreadsheets i've put together.

cheers!

Job said:
JMB,

Thanks for the heads up on the with/end with. Didn't think about that one.
I've made those changes and thanks for the link....

Cheers!

JMB said:
You can turn off screenupdating
Application.ScreenUpdating = False

Turn off calculation if you don't need it. If you need the workbook
calculated at some point in your code, use "Calculate", "CalculateFull",
or I
think you can calculate individual worksheets by preceding the statement
with
the sheet name or codename (Sheets(1).Calculate)

application.Calculation = xlCalculationManual

Use With / End With when making multiple references to the same object.

With Sheets(z)
.[A1].FormulaR1C1 = "StatementDte"
.[B1].FormulaR1C1 = "COAS"
End With


Note you don't have to select/activate everything in order to do what you
need.

Range("A1").Select
Selection.Copy

is same as Range("A1").Copy


Don't forget to turn ScreenUpdating and Calculation back on at the end of
your code (although I think Excel turns ScreenUpdating back on
automatically).
Application.ScreenUpdating = TRUE
application.Calculation = xlCalculationAutomatic

Also see http://www.microsoft.com/officedev/articles/Opg/013/013.htm



Job said:
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
Click to expand...
Click to expand...
Click to expand...
 
J

Job

Ok,

I changed the autocalc to manual, then I used the autofill to the last row
of data with the formulas. Then turned the autocalc back on. Seems to have
cut the time down. I'll run the full code and see how much of an overall
improvement it is.


JMB said:
welcome. but take jims advice and take a serious look at the calculation.
if your macro does not need any info from your workbook(s) (that require
the
workbook to be calculated) in order to run, turn the calc off/on. i think
it
makes the biggest dent in run time in the spreadsheets i've put together.

cheers!

Job said:
JMB,

Thanks for the heads up on the with/end with. Didn't think about that
one.
I've made those changes and thanks for the link....

Cheers!

JMB said:
You can turn off screenupdating
Application.ScreenUpdating = False

Turn off calculation if you don't need it. If you need the workbook
calculated at some point in your code, use "Calculate",
"CalculateFull",
or I
think you can calculate individual worksheets by preceding the
statement
with
the sheet name or codename (Sheets(1).Calculate)

application.Calculation = xlCalculationManual

Use With / End With when making multiple references to the same object.

With Sheets(z)
.[A1].FormulaR1C1 = "StatementDte"
.[B1].FormulaR1C1 = "COAS"
End With


Note you don't have to select/activate everything in order to do what
you
need.

Range("A1").Select
Selection.Copy

is same as Range("A1").Copy


Don't forget to turn ScreenUpdating and Calculation back on at the end
of
your code (although I think Excel turns ScreenUpdating back on
automatically).
Application.ScreenUpdating = TRUE
application.Calculation = xlCalculationAutomatic

Also see http://www.microsoft.com/officedev/articles/Opg/013/013.htm



:

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
Click to expand...
Click to expand...
Click to expand...
 
N

Nick Hebb

Another option would be to process the data in the background, storing
it in a bunch of text files (65k rows/file), then import each text file
into a new sheet using QueryTables. The pseudo code is as follows:



Create new folder

Outer loop: while not EOF of input file
create new output file in the new folder
write field headers to output file
output file row counter = 0
Inner loop: while output file row counter <65000 and not input EOF
read line
transform contents of line
write line to output file in csv format (NO SPACE after comma)
increment output file row counter
End inner loop
End outer loop

For each file in new folder
Select worksheet
Import data from text file using ActiveSheet.QueryTables
Next

Delete files and new folder



I would think that this would much faster since you are pre-processing
the data without having to interface with the spreadsheet and the Excel
object hierarchy. QueryTables is very fast and works on formatted text
files just as well as it does on databases.

Try recording a macro while doing Data > Import External Data > Import
Data. This will prompt you for a data source. Navigate to the text
file like you're opening a file, and follow the importing wizard.
 
J

Job

Thanks for the comments Nick. Not too familiar with this. I'll research as
to how this works. Thanks!
 
J

Job

TonT,

Thanks for the input. Yes, I write enough code that I need to learn the
most efficient ways of doing things. Thanks for the link. I didn't realize
the [A1] reference style was slower. I also thought that inserting line by
line formulas and then making them equal to themselves would be faster.
Turns out that with manual calc on and filling the entire spreadsheet with
the formula, then turning back on the auto calc is faster. Again, thanks
for the link, I'll incorporate what I learn into the code.

Cheers!
 
J

Job

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


Job said:
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
Click to expand...
 
N

Nick Hebb

That's cool that the DeleteRows() sub runs faster, but I would think
that it would be better to pre-process the data before importing it
into Excel to avoid that step altogether. Plus, deleting rows after
the fact will lead to inconsistent row counts in each of your sheets.
But that may not matter to you.

Oh well, just my $0.02
 
J

Job

Nick,

Are you suggesting that I open the text file, do all of the extractions via
the formula's in my code on each line, then paste that line into another
text file that is formatted correctly, then import the data into Excel?

I don't know how to manipulate raw data like that. Ideally I could do that
and get rid of the blanks in one shot and put it directly into Access, or
import the data into Access, apply the extraction in Access and just leave
it in the table. However, I'm not sure how to actually do the extraction in
Access the same way it works in a spreadsheet. Ultimately I push the data
to an Access table from the Excel sheet. If any of the above is possible
that would be excellent! What do you think?
 
J

Job

I forgot to add that the inconsistant row counts doesn't matter for what I'm
doing. After all of the scrubbing takes place, I put all of the data into
one sheet then push it to Access, or I could iterate through the sheets and
push the data...
 
N

Nick Hebb

I didn't realize that ultimately this was going into an Access
database. As usual there are several ways you could do this.

One way would be to do as I described above - reading the data from one
file, scrubbing it, and saving it to a new text file. To scrub it,
basically do what you did above but replace the Range() objects and
RC[] references with variable names. Trim, Len, Left, Right, etc will
all work the same. Only write lines to the new text file that are
valid instead of deleting them after the fact.

Put this all in a Sub Procedure in Access, then write an Access macro
that calls the sub then calls TransferText with the table name and the
input file name.

The other way, which would be more complex, would be to write a sub in
Access that reads each line, scrubs the data, then uses DAO or ADO to
append the data to a table.

Either way, you've got some reading to do. :)
 
J

Job

Hmmm...This is great info, never thought of scrubbing the data using
variables...I'll check into this..seem like it would be much faster. Any
links you have handy that would get me started? Thanks for all your help!
 
N

Nick Hebb

If you post:

- the input file format
- the Access table info (table name, field names, data types, and how
each field is derived from the input file fields)
- the criteria for deleting a row

Then I could post some sample code to get you started.
 
J

Job

Thanks.
Remember when viewing this that a lot of what I've coded puts the data into
db format, for example, not every line of data has a OrgNum, so when I find
the org num, then each row will have the same OrgNum until the criteria is
met and it finds a new OrgNum. If you look at the code pasted earlier
you'll see that after the data is imported into Excel, 14 colums are
inserted.

1 - The input file format is Tab Delimeted with quotes as text qualifiers.
2 - Access Table Field names:
- StatementDte - Text - TEXT([TransDte]*1,""yyyymm"") - dependant upon
the [TransDte] variable/cell
-COAS - Number(Double) - Refers to the first 'column'
-OrgNum - Number(Double) - Refers to the first 'column'
-Fund - Text - Refers to the first 'column'
-TransDte - Date/Time - Refers to the first 'column'
-TransType - Text - Refers to the first 'column'. Is dependent upon the
len of the [TransDte]
-DocNum - Text - Refers to the first 'column'. Is dependent upon the
len of the [TransType] and [TransDte]
-RefNum - Number(Double) - Refers to the first 'column'. Is dependent
upon the len of the [TransType] and [TransDte] and DocNum
-AcctNum - Number(Double) - Refers to the first 'column'. Is dependent
upon on if [TransDte] is blank then this is blank.
-BudgetActivity - Number(Long Int) - Refers to the first 'column'. Is
dependent upon on if [TransDte] is blank then this is blank.
-TransActivity - Number(Double) - Refers to the third 'column'. Is
dependent upon on if [TransDte] is blank then this is blank.
-EncumActivity - Number(Long Int) - Refers to the Fourth 'column'. Is
dependent upon on if [TransDte] is blank then this is blank.
-CMType - Text - Refers to the fifth'column'. Is dependent upon on if
[TransDte] is blank then this is blank.
-TransDesc - Text - Refers to the sixth 'column'. Is dependent upon on
if [TransDte] is blank then this is blank.


3 - If there is an error extracting the TransDte then the StatementDte
doesn't get populated. If there is no StatementDte, then it's ok to delete
the line.

Hopefully #2 above make sense.First is the column header, second is the data
type, third tells what 'column' of data it comes from. If you look at the
formula in the first post, it should make sense.
 
G

Guest

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




Job said:
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


Job said:
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
Click to expand...
Click to expand...
 
N

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).
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

COPY BY MACRO DOWN TO LAST VALUE CELL IN COLUMN "A" 1
how do i separate addresses and place results in another cell 4
display calculation next row 5
removing blank rows taking a long time 4
Problem with line of code / syntax 4
Replacing "Div/0!" errors 3
Autofill is overwriting the column title..... 4
Code stops after column "L" 1

Top