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