Increase efficiency of a part of the VBA code that runs very slow

Question

I have the following code that works and does the following: First, from a "template" file, it fetches information from a closed file and fills in some required structure. Next, it opens a second closed file and looks for some data from the "template" to bring a certain result. In the same way and with this data already in the template, some conditions are worked on so that a column is completed if these conditions are met. The problem is that all this takes 56 seconds on my PC. How can I speed up that whole process to less than 10 seconds?

I realized that the delay is due to the process that is carried out in columns 12, 13, 14 and 15 with the index match process in the librodatos2.

I have reviewed several forums and contributions where they mention that I should implement a 2D array but I have not been able to understand it to be able to implement it.

Can someone help me guide this setting to achieve greater speed in this code?

Thanks in advance

Sub Control()
Application.ScreenUpdating = False
Const Path As String = "C:\Users\10101415\Desktop\AUT_SOX\SERV\"
Dim filename As String
filename = Dir(Path & "\" & "*.xls")
Dim librodatos As Workbook
Set librodatos = Workbooks.Open(Path & filename)
ult = librodatos.Sheets(1).Cells(5, 1).End(xlDown).Row
fin = Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(3, 2).End(xlDown).Row
On Error Resume Next




''COPIAR RANGO DE DATOS DE LIBRO CERRADO
librodatos.Sheets(1).Range("A5:A" & ult).Copy
''NO GUARDAR CAMBIOS EN LIBRO CERRADO
Application.ScreenUpdating = False

Workbooks("VERIFICACIÓN - BLANCO.xlsm").Activate
With ActiveWorkbook
.Sheets(1).Cells(3, 2).Activate
.Sheets(1).Cells(3, 2).PasteSpecial xlPasteValues
.Sheets(1).Range("B3:C" & fin).NumberFormat = "General"
.Sheets(1).Range("B3:C" & fin).Value = ActiveWorkbook.Sheets(1).Range("B3:B" & fin).Value
.Sheets(1).Range("B3:C" & fin).NumberFormat = "00000000000000"
End With

librodatos.Sheets(1).Range("C5:C" & ult).Copy
Workbooks("VERIFICACIÓN - BLANCO.xlsm").Activate
With ActiveWorkbook
.Sheets(1).Cells(3, 3).Activate
.Sheets(1).Cells(3, 3).PasteSpecial xlPasteValues
.Sheets(1).Range("C3:C" & fin).NumberFormat = "General"
.Sheets(1).Range("C3:C" & fin).Value = ActiveWorkbook.Sheets(1).Range("C3:C" & fin).Value
End With

librodatos.Sheets(1).Range("D5:D" & ult).Copy
Workbooks("VERIFICACIÓN - BLANCO.xlsm").Activate
ActiveWorkbook.Sheets(1).Cells(3, 4).Activate
ActiveWorkbook.Sheets(1).Cells(3, 4).PasteSpecial xlPasteValues

librodatos.Sheets(1).Range("F5:F" & ult).Copy
Workbooks("VERIFICACIÓN - BLANCO.xlsm").Activate
ActiveWorkbook.Sheets(1).Cells(3, 5).Activate
ActiveWorkbook.Sheets(1).Cells(3, 5).PasteSpecial xlPasteValues

librodatos.Sheets(1).Range("H5:H" & ult).Copy
Workbooks("VERIFICACIÓN - BLANCO.xlsm").Activate
ActiveWorkbook.Sheets(1).Cells(3, 6).Activate
ActiveWorkbook.Sheets(1).Cells(3, 6).PasteSpecial xlPasteValues

librodatos.Sheets(1).Range("O5:O" & ult).Copy
Workbooks("VERIFICACIÓN - BLANCO.xlsm").Activate
ActiveWorkbook.Sheets(1).Cells(3, 7).Activate
ActiveWorkbook.Sheets(1).Cells(3, 7).PasteSpecial xlPasteValues

librodatos.Application.CutCopyMode = False
librodatos.Close savechanges:=False

Call Consecutivo

Application.ScreenUpdating = False
Const Path2 As String = "C:\Users\10101415\Desktop\AUT_SOX\SAB\"
Dim filename2 As String
filename2 = Dir(Path2 & "\" & "*.xlsx")

Dim librodatos2 As Workbook
Set librodatos2 = Workbooks.Open(Path2 & filename2)
ult2 = librodatos2.Sheets(1).Cells(2, 1).End(xlDown).Row

''FILTRAR POR COLUMNA DE SOLICITUDES NO VACIAS
With librodatos2
.ActiveSheet.Range("A1:BN" & ult2).AutoFilter Field:=51, Criteria1:="<>"
.Sheets(1).Range("A1:BN" & ult2).Copy
.Sheets.Add After:=ActiveSheet
.Sheets(2).Cells(1, 1).PasteSpecial xlPasteValues

ULT30 = Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(3, 2).End(xlDown).Row
ULT31 = librodatos2.Sheets(2).Cells(2, 1).End(xlDown).Row
For G = 3 To ULT30

.Sheets(2).Range("C2:C" & ULT31).NumberFormat = "General"
.Sheets(2).Range("C2:C" & ULT31).Value = ActiveWorkbook.Sheets(2).Range("C2:C" & ULT31).Value
.Sheets(2).Range("AY2:AY" & ULT31).NumberFormat = "General"
.Sheets(2).Range("AY2:AY" & ULT31).Value = ActiveWorkbook.Sheets(2).Range("AY2:AY" & ULT31).Value

Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(G, 12) = WorksheetFunction.Index(librodatos2.Sheets(2).Range("BH2", "BH" & ULT31), WorksheetFunction.Match(Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(G, 2).Value, librodatos2.Sheets(2).Range("AY2", "AY" & ULT31), 0))
Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(G, 13) = WorksheetFunction.Index(librodatos2.Sheets(2).Range("BI2", "BI" & ULT31), WorksheetFunction.Match(Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(G, 2).Value, librodatos2.Sheets(2).Range("AY2", "AY" & ULT31), 0))
Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(G, 14) = WorksheetFunction.Index(librodatos2.Sheets(2).Range("BL2", "BL" & ULT31), WorksheetFunction.Match(Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(G, 2).Value, librodatos2.Sheets(2).Range("AY2", "AY" & ULT31), 0))
Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(G, 15) = WorksheetFunction.Index(librodatos2.Sheets(2).Range("A2", "A" & ULT31), WorksheetFunction.Match(Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(G, 2).Value, librodatos2.Sheets(2).Range("AY2", "AY" & ULT31), 0))


Next G
.Application.CutCopyMode = False
.Close savechanges:=False
End With


For q = 3 To ULT30

If Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 14) = "0" And Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 12) <> "" Then
Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 11) = "OK firma digital - On Base"

ElseIf Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 14) = "2" And Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 12) <> "" And Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 13) = "MARIA" Then
Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 11) = "OK firma digital - On Base"


ElseIf Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 14) = "2" And Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 12) <> "" And Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 13) = "MILENA" Then
Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 11) = "OK firma digital - On Base"


ElseIf Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 14) = "3" And Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 12) <> "" And Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 13) = "ALFONSO" Then
Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 11) = "OK firma digital - On Base"


Else
Workbooks("VERIFICACIÓN - BLANCO.xlsm").Sheets(1).Cells(q, 11) = "Revisar"


End If
Next q

End Sub


Sub Consecutivo()
Dim total As Variant
FN2 = (ActiveWorkbook.Sheets(1).Cells(3, 2).End(xlDown).Row) - 2
ReDim total(1 To FN2) As Long
For i = 1 To FN2
total(i) = i
Next i

total = Application.WorksheetFunction.Transpose(total)
Range("A3").Resize(FN2, 1).Value = total
End Sub

You must read how avoid `.select` or `.activate` to speedup your codes. https://stackoverflow.com/q/10714251/5514747 — Harun24hr, Mar 24 '22 at 02:49
Also comment out that `On Error Resume Next` - if something goes wrong you'll not know about it. And use variables for workbooks/worksheets. — Tim Williams, Mar 24 '22 at 03:15
Is `Workbooks("VERIFICACIÓN - BLANCO.xlsm")` where your code is? — Tim Williams, Mar 24 '22 at 03:50

Increase efficiency of a part of the VBA code that runs very slow

0 Answers0