Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I have 2 macros (importH04v2 and importH04a) extracting difference data from
same text file. However, i noted ImportH04a 10 times slower than ImportH04v2 even though the data is not significantly difference. I would like to get your view on what is the problem for the slow process of ImportH04a. (1) Sub ImportH04v2() Dim i As Integer, a As String Dim lastrow As Integer, lastrow1 As Integer Dim cheqdate, cheqdate1 Dim Fname, Fname1 As String Dim newnumber Fname = Application.GetOpenFilename _ (filefilter:="Text Files(*.txt),*.txt,All Files (*.*),*.*") If Fname = False Then MsgBox "You didn't select a file" Exit Sub End If Fname1 = Dir(Fname) Application.ScreenUpdating = False Workbooks.OpenText Filename:=Fname, Origin:=xlWindows, StartRow _ :=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(1, 2), Array( _ 11, 9), Array(12, 1), Array(41, 9), Array(51, 2), Array(61, 2), Array(71, 9), Array(74, 2), _ Array(80, 9), Array(84, 1), Array(95, 9), Array(96, 2), Array(103, 1), Array(119, 9)) cheqdate = Cells(7, 1).Value cheqdate1 = CDate(cheqdate) ' start testing the date If Workbooks("H04-CF.xls").Worksheets("Check").Cells(2, 1).Value = "" Then GoTo skipcheqdate End If For i = 2 To 40 Step 1 If Workbooks("H04-CF.xls").Worksheets("Check").Cells(i, 1).Value = cheqdate1 Then MsgBox "The H04 with this date: " & cheqdate & " already exist!" Windows(Fname1).Close SaveChanges:=False Exit Sub End If Next i ' end testing the date skipcheqdate: Application.ScreenUpdating = False lastrow = ActiveSheet.UsedRange.Rows.Count For i = lastrow To 1 Step -1 If Left(Cells(i, 1).Value, 4) < "0000" Then Rows(i).Delete Else Cells(i, 9).Value = cheqdate End If Application.StatusBar = "Processing line " & i Next lastrow1 = ActiveSheet.UsedRange.Rows.Count ' to copy deskcode to empty cell For i = 1 To lastrow1 Step 1 If i < 1 Then If Cells(i, 1).Value = "" And Cells(i, 9).Value < "" Then a = "'" & Cells(i - 1, 1).Text Cells(i, 1).Value = a Cells(i, 5).Value = "'" & Cells(i - 1, 5).Text End If End If ' to move "-" from back to front ' If Right(Cells(i, 8), 1) = "-" Then ' newnumber = Left(Cells(i, 8), Cells(i, 8).Characters.Count - 1) ' Cells(i, 8).Formula = "-" & newnumber ' End If Application.StatusBar = "Reformatting line " & i Next Windows(Fname1).Activate ActiveSheet.UsedRange.Select Selection.Copy ' switch to H04 file Windows("H04-CF.xls").Activate Sheets("Data").Activate lastrow = ActiveSheet.UsedRange.Rows.Count Cells(lastrow + 1, 1).Activate ActiveSheet.Paste Application.CutCopyMode = False Sheets("Check").Activate ' put in checkdate For i = 2 To 40 Step 1 If Cells(i, 1).Value = "" Then Cells(i, 1).Value = cheqdate GoTo impcwl End If Next i impcwl: Application.ScreenUpdating = True Application.StatusBar = False Windows(Fname1).Close SaveChanges:=False End Sub 2) Sub ImportH04a() Dim i Dim lastrow Dim cheqdate, cheqdate1 Dim Fname, Fname1 Fname = Application.GetOpenFilename _ (filefilter:="Text Files(*.txt),*.txt,All Files (*.*),*.*") If Fname = False Then MsgBox "You didn't select a file" Exit Sub End If Fname1 = Dir(Fname) Workbooks.OpenText Filename:=Fname, Origin:=xlWindows, StartRow _ :=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(1, 2), Array( _ 11, 9), Array(12, 1), Array(41, 9), Array(51, 2), Array(61, 2), Array(71, 1), Array(80, 1), _ Array(95, 9)) cheqdate = Cells(7, 1).Value cheqdate1 = CDate(cheqdate) ' start testing the date For i = 2 To 40 Step 1 If Workbooks("H04.xls").Worksheets("Check").Cells(i, 1).Value = cheqdate1 Then MsgBox "The H04 with this date: " & cheqdate & " already exist!" Windows(Fname1).Close SaveChanges:=False Exit Sub End If Next i ' end testing the date lastrow = ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For i = lastrow To 1 Step -1 If Left(Cells(i, 1), 4) < "0000" Then Rows(i).Delete Else Cells(i, 5).Value = cheqdate End If Next Cells.Select Cells.EntireColumn.AutoFit Windows(Fname1).Activate ActiveSheet.UsedRange.Select Selection.Copy ' switch to H04 file Windows("H04.xls").Activate Sheets("Data").Activate lastrow = ActiveSheet.UsedRange.Rows.Count Cells(lastrow + 1, 1).Activate ActiveSheet.Paste Application.CutCopyMode = False Sheets("Check").Activate ' put in checkdate For i = 2 To 40 Step 1 If Cells(i, 1).Value = "" Then Cells(i, 1).Value = cheqdate GoTo impcwl End If Next i impcwl: Application.ScreenUpdating = True Windows(Fname1).Close SaveChanges:=False End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Check Box and Button Macros | New Users to Excel | |||
is it possible 2 macros in 1 check box? | Excel Discussion (Misc queries) | |||
Check box macros | Excel Discussion (Misc queries) | |||
I need help with macros and check boxes. | New Users to Excel | |||
Check active sheet not the one with macros | Excel Programming |