Why 2 macros differ so much in speed?

M

MArtin Los

I have 2 macros who basically copy values from an .txt
file (FileToOpen) to an existing Excel spreadsheet.

Why does Macro 1 take a long 30 seconds to run and Macro 2
only 2 second, if the filesize is nearly equal?

TIA

Martin

Macro 1:
Sub Importar_vdn()
Dim Fecha_actual As Date
Dim Fecha_import As Date
Dim lngsourceLr As Long
Dim lngdestLr As Long
Dim lngdestRange As Long
Dim rwIndex As Long
Dim wkb As Workbook
Dim wks As Worksheet
Dim DateDiff1 As Long
Dim SourceRange As Range
Dim DestRange As Range

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set wkb = Workbooks("Workbook1.XLS")
Set wks = wkb.Worksheets("Datos VDN")
wks.Activate
lngdestLr = LastRow2(ActiveSheet)
' Sheets("Datos VDN").Select
Range("D" & lngdestLr).Select
Fecha_actual = CDate(ActiveCell.Value)

FileToOpen = Application.GetOpenFilename
("Textfiles (*.txt),*.txt")

If FileToOpen <> False Then

'Aquí necesita un procedimiento que me permite abrir
cualquier fichero (independentemente del nº de líneas!)

' Open textfile FileToOpen (tiene 34 columnas:
desde columna A hasta columna AH)
Workbooks.OpenText Filename:=FileToOpen,
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote,
ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False,
Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 2), Array(3, 1),
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array
(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1),
Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23,
1), Array(24, 1), Array(25, 1), Array(26, 1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array
(30, 1), Array(31, 1), Array(32, 1), Array( _
33, 1), Array(34, 1))
' Array(2,2) indica que columna hay que
importarla como texto
Else: Exit Sub
End If

Fecha_import = CDate(Range("B1").Value)

DateDiff1 = DateDiff("d", Fecha_actual, Fecha_import)

If DateDiff1 = 1 Or DateDiff1 = 0 Then
lngsourceLr = LastRow2(ActiveSheet)
lngdestRange = lngdestLr + lngsourceLr - 2
wks.Activate
ActiveCell.Offset(1, 1).Range("A1").Activate
ActiveWindow.ActivateNext
Set SourceRange = ActiveSheet.Range("B3:AH" &
lngsourceLr)

ActiveWindow.ActivateNext
Set DestRange = wks.Range("E" & lngdestLr + 1
& ":AK" & lngdestRange)
SourceRange.copy DestRange
Application.CutCopyMode = False

For rwIndex = lngdestLr + 1 To lngdestRange
wks.Cells(rwIndex, 1).Formula = "=D" &
rwIndex & "&E" & rwIndex
wks.Cells(rwIndex, 2).Formula = "=C" &
rwIndex & "&E" & rwIndex
wks.Cells(rwIndex, 3).Formula = "=TEXT(D"
& rwIndex & ",""m"")"
wks.Cells(rwIndex, 4).Value = Fecha_import
Next rwIndex

ActiveWindow.ActivateNext
ActiveWindow.Close False

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Else: MsgBox "Fecha incorrecta"
End If
End Sub

Function LastRow2(sh As Worksheet)
On Error Resume Next
LastRow2 = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Sub Importar_splitskill()
Dim Fecha_actual As Date
Dim Fecha_import As Date
Dim lngsourceLr As Long
Dim lngdestLr As Long
Dim lngdestRange As Long
Dim rwIndex As Long
Dim wkb As Workbook
Dim wks As Worksheet
Dim DateDiff1 As Long
Dim SourceRange As Range
Dim DestRange As Range

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set wkb = Workbooks("Workbook1.XLS")
Set wks = wkb.Worksheets("Datos Skill")
wks.Activate
lngdestLr = LastRow2(ActiveSheet)
' Sheets("Datos VDN").Select
Range("D" & lngdestLr).Select
Fecha_actual = CDate(ActiveCell.Value)

FileToOpen = Application.GetOpenFilename
("Textfiles (*.txt),*.txt")

If FileToOpen <> False Then


Workbooks.OpenText Filename:=FileToOpen, Origin _
:=xlWindows, StartRow:=1, DataType:=xlDelimited,
TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False,
FieldInfo:=Array(Array(1, 2), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5,
1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12,
1), Array(13, 1), Array(14, 1), Array(15 _
, 1), Array(16, 1), Array(17, 1), Array(18, 1),
Array(19, 1), Array(20, 1), Array(21, 1), _
Array(22, 1), Array(23, 1), Array(24, 1), Array
(25, 1), Array(26, 1), Array(27, 1), Array( _
28, 1), Array(29, 1), Array(30, 1), Array(31, 1),
Array(32, 1), Array(33, 1), Array(34, 1), _
Array(35, 1), Array(36, 1), Array(37, 1)),
TrailingMinusNumbers:=True

Else: Exit Sub

End If

Fecha_import = CDate(Range("A3").Value)

DateDiff1 = DateDiff("d", Fecha_actual, Fecha_import)

If DateDiff1 = 1 Or DateDiff1 = 0 Then
'Copiar datos
lngsourceLr = LastRow2(ActiveSheet)
lngdestRange = lngdestLr + lngsourceLr - 2
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
If InStr(1, FileToOpen, "cce") <> 0 Then
Range("C3:C" & lngsourceLr).Value = "cce"
ElseIf InStr(1, FileToOpen, "tuerca") <> 0 Then
Range("C3:C" & lngsourceLr).Value
= "tuerca"
Else:
MsgBox "Error"
Exit Sub
End If
wks.Activate
ActiveCell.Offset(1, 3).Range("A1").Activate
ActiveWindow.ActivateNext
Set SourceRange = ActiveSheet.Range("B3:AL" &
lngsourceLr)
ActiveWindow.ActivateNext
Set DestRange = wks.Range("G" & lngdestLr + 1
& ":AQ" & lngdestRange)
SourceRange.copy DestRange
Application.CutCopyMode = False

' Copiar formulas
For rwIndex = lngdestLr + 1 To lngdestRange
wks.Cells(rwIndex, 1).Formula = "=D" &
rwIndex & "&G" & rwIndex
wks.Cells(rwIndex, 2).Formula = "=C" &
rwIndex & "&G" & rwIndex
wks.Cells(rwIndex, 3).Formula = "=TEXT(D"
& rwIndex & ",""m"")"
wks.Cells(rwIndex, 4).Value = Fecha_import
wks.Cells(rwIndex, 5).Formula = "=I" &
rwIndex & "*L" & rwIndex
wks.Cells(rwIndex, 6).Formula = "=M" &
rwIndex & "*L" & rwIndex
Next rwIndex
ActiveWindow.ActivateNext
ActiveWindow.Close False
Application.Calculation =
xlCalculationAutomatic
Application.ScreenUpdating = True
Else: MsgBox "Fecha incorrecta"
End If
End Sub
 

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 part of text file 4
Wildcards and Looping 2
append multiple worksheets data into a single multi-dimensional array 4
Open Text Files/Format/Save as .xls for multiple files. 9
IMPORT TEXT FILE WITH VB 1
How to force column formatting (text, date, etc) when loading a fixed width text file into an array? 3
How to maintain size of array: UniqRow 4
Open four Wbooks, copy four columns from each to Master Wbook 16

Top