LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3
Default Pls help to check my macros

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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Check Box and Button Macros SweetTea023 New Users to Excel 1 June 18th 09 08:36 PM
is it possible 2 macros in 1 check box? HERNAN Excel Discussion (Misc queries) 1 May 15th 08 04:09 PM
Check box macros Sunlover Excel Discussion (Misc queries) 5 January 10th 08 01:28 AM
I need help with macros and check boxes. Marc New Users to Excel 2 March 20th 06 04:20 PM
Check active sheet not the one with macros Oscar Excel Programming 2 July 30th 04 04:32 PM


All times are GMT +1. The time now is 05:24 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"