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