Optimize loop multiple variables

Question

I have tons of data and I need to optimize this lines but i simply do not know how ...

Some lines of "x" will be black so I don't know how to use arrays without including this blank lines or how to write them without them.

x,a,b & d are variable numbers.

a = Sheets("MODULOS").Range("a1048576").End(xlUp).Row
b = Sheets("TODO").Range("a1048576").End(xlUp).Row

For x = 1 To b
Range("Z1").Select
ActiveCell.Offset(x, 0).Select

For i = 1 To (a - 1)

If ActiveCell.Value <> 0 Then
    d = Sheets("AGREGADO").Range("a1048576").End(xlUp).Row
    Sheets("AGREGADO").Cells(d + 1, 1).Value = Sheets("TODO").Cells(x + 1, 7).Value
    Sheets("AGREGADO").Cells(d + 1, 3).Value = Sheets("TODO").Cells(x + 1, 25 + i).Value
    Sheets("AGREGADO").Cells(d + 1, 2).Value = Sheets("TODO").Cells(1, 25 + i).Value
    Sheets("AGREGADO").Cells(d + 1, 4).Value = Sheets("TODO").Cells(x + 1, 33 + a).Value
End If

    ActiveCell.Offset(0, 1).Select
Next i
Next x

Why don't you do this with an in-cell formula instead of VBA? — trincot
– trincot, Commented Feb 2, 2018 at 11:55
NB: Your title says "optimize", but your code does not work correctly, so that is not optimization you need, but fixing. — trincot
– trincot, Commented Feb 2, 2018 at 11:58
Quick optimize: Application.Calculation = xlCalculateManual , Application.ScreenUpdating = False at the begining and Application.Calculation = xlCalculationAutomatic , Application.ScreenUpdating = True before exit. — TomJohn
– TomJohn, Commented Feb 2, 2018 at 12:05

Pierre44 · Accepted Answer · 2018-02-02 13:07:41Z

There are a few way to make your code faster:

Summary (ranked by importance):

dis-activate Automatic Calculation and screen updating (as in the comment from Tomjohnriddle)
Avoid the .Select and ActiveCell
Use WITH where possible when working with objects

In your code it would look like this:

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim ra As Range

a = Sheets("MODULOS").Range("a1048576").End(xlUp).Row
b = Sheets("TODO").Range("a1048576").End(xlUp).Row

For x = 1 To b

ra = Cells(1 + x, 26)

With Sheets("AGREGADO")

For i = 1 To (a - 1)

If ra.Value <> 0 Then
    d = Sheets("AGREGADO").Range("a1048576").End(xlUp).Row
    .Cells(d + 1, 1).Value = Sheets("TODO").Cells(x + 1, 7).Value
    .Cells(d + 1, 3).Value = Sheets("TODO").Cells(x + 1, 25 + i).Value
    .Cells(d + 1, 2).Value = Sheets("TODO").Cells(1, 25 + i).Value
    .Cells(d + 1, 4).Value = Sheets("TODO").Cells(x + 1, 33 + a).Value
End If

    ra = Cells(1 + x, 26 + 1)

Next i
Next x

End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Collectives™ on Stack Overflow

Optimize loop multiple variables

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related