I am using excel vba 2010 to create two spreadsheets in a workbook that already exists. The source for these new spreadsheets is another workbook with 12 spreadsheets (each one with 40000 rows) the first time that I am creating these two spreadsheets took more than 2 hours. (I have chosen aprox. 13000 rows to create these two spreadsheets). How can I reduce the time consumption?
Sub creaInventarios(wkArchivoROT, wkArchivoDatos)
Dim book_I As Workbook, wbk1 As Workbook
Dim sheet_IQB As Worksheet, sheet_I As Worksheet, sheet_P As Worksheet, sheet_FIN As Worksheet
Dim longitudCampo As Integer
Dim nf As Long, nfo As Long, orden As Long, divida As Long, queda As Long, nf1 As Long, canrow As Long
Dim chkInventario As String
Dim texto As Range
Dim codigoItem As Range
Dim descrItem As Range
Dim itemVendedor As Range
Dim puntoReorden As Range
Dim qtyOnHand As Range
Dim qtyOnSale As Range
Dim qtyAvailable As Range
Dim suggestReorden As Range
Dim qtyReorden As Range
Dim earlySale As Range
Dim salesThisWeek As Range
Dim errorCampo As Boolean
Set book_I = Workbooks.Open(wkArchivoROT)
Set sheet_I = book_I.Worksheets(9)
Set sheet_P = book_I.Worksheets(8)
Set wbk1 = Workbooks.Open(wkArchivoDatos)
Set sheet_FIN = wbk1.Worksheets("Final")
nf = 3
nfo = 7
orden = 0
lee_Fin:
If sheet_FIN.Range("C" & nf) = " " Or sheet_FIN.Range("C" & nf) = vbNullString Then
If sheet_FIN.Range("B" & nf).Value = " " Or sheet_FIN.Range("B" & nf) = vbNullString Then
GoTo finInventario
End If
End If
queda = Len(sheet_FIN.Range("C" & nf).Value)
If queda = 0 Then
nf = nf + 1
GoTo lee_Fin
End If
Set codigoItem = sheet_FIN.Range("C" & nf)
chkInventario = Mid(codigoItem.Value, 1, 3)
If chkInventario = "MPA" Or chkInventario = "MPC" Or chkInventario = "PPA" Or chkInventario = "PTC" Then
GoTo checkIgual
Else
nf = nf + 1
GoTo lee_Fin
End If
checkIgual:
Set texto = sheet_FIN.Range("B" & nf)
Set descrItem = sheet_FIN.Range("D" & nf)
Set itemVendedor = sheet_FIN.Range("E" & nf)
Set puntoReorden = sheet_FIN.Range("F" & nf)
Set qtyOnHand = sheet_FIN.Range("G" & nf)
Set qtyOnSale = sheet_FIN.Range("H" & nf)
Set qtyEnsamble = sheet_FIN.Range("I" & nf)
Set qtyAvailable = sheet_FIN.Range("J" & nf)
Set suggestReorden = sheet_FIN.Range("L" & nf)
Set qtyReorden = sheet_FIN.Range("M" & nf)
Set earlySale = sheet_FIN.Range("N" & nf)
Set salesThisWeek = sheet_FIN.Range("O" & nf)
sheet_P.Range("A" & nfo).Value = codigoItem.Value
sheet_I.Range("A" & nfo).Value = codigoItem.Value
sheet_P.Range("B" & nfo).Value = descrItem.Value
sheet_I.Range("B" & nfo).Value = descrItem.Value
sheet_P.Range("C" & nfo).Value = puntoReorden.Value
sheet_I.Range("C" & nfo).Value = qtyOnHand.Value
sheet_P.Range("D" & nfo).Value = qtyOnHand.Value
'sheet_I.Range("C" & nfo).Value = qtyAvailable.Value
'sheet_P.Range("D" & nfo).Value = qtyAvailable.Value
sheet_I.Range("D" & nfo).Value = qtyOnSale.Value
sheet_P.Range("E" & nfo).Value = qtyOnSale.Value
sheet_I.Range("E" & nfo).Value = qtyEnsamble.Value * -1
sheet_P.Range("F" & nfo).Value = qtyEnsamble.Value * -1
sheet_I.Range("F" & nfo).Value = qtyAvailable.Value
sheet_P.Range("G" & nfo).Value = qtyAvailable.Value
orden = orden + 1
sheet_I.Range("U" & nfo).Value = orden
sheet_P.Range("L" & nfo).Value = orden
nfo = nfo + 1
nf = nf + 1
GoTo lee_Fin
finInventario:
MsgBox "Continuar", vbInformation, "WARNING"
End Sub
Turning off screen updating and calculation while your code is running is usually helpful, and can be done like so:
Here and here are some good articles that go into a number of other VBA best practices for speed.
Also if you don't want to trigger Sheet_Change and Workbook_change, each ime you change the value of a single cell, add
but be careful if your code stops for error/debugging, you will need to enableevents again (depending if events are needed for other actions)