Can someone help me optimize the VBA loop in excel - vba

Question

My worksheet have 6000 rows. This loop takes me more than 20minutes to finish. It is too long for me because I have many columns to run this loop. Can someone help me?
Dim i As Integer
For i = ActiveCell.Row To 5771
If Cells(i, ActiveCell.Column - 1).Value = 0 And Cells(i, ActiveCell.Column).Value = "" Then
Cells(i, ActiveCell.Column).Value = 0
ElseIf Cells(i, ActiveCell.Column - 1).Value = 1 Then
Range(Cells(i, ActiveCell.Column), Cells(i + 9, ActiveCell.Column)).Value = 1
ElseIf Cells(i, ActiveCell.Column - 1).Value = -1 Then
Range(Cells(i, ActiveCell.Column), Cells(i + 9, ActiveCell.Column)).Value = -1
End If
Next i

Answer 1

It is hard to tell exactly what you're trying to do. The loop structure you're using appears to be very inefficient: you're looping over rows in a range, and performing some evaluation/logic test on each cell.
If the adjacent (to the left) cell's value is 1 or -1, then you're filling the cell and the next 9 cells with that value. But then when you hit the Next in your loop, you will perform your test on those cells. So, either you should not be filling a value down 10 rows, or you should avoid testing those rows since presumably nothing needs to be done with them (otherwise you should not have filled them in in the first place!) So you can see why I am a little confused.
In any case, I assume that you do not need to test the 9 rows beneath when the Cells(i, ActiveCell.Column - 1).Value = 1 or Cells(i, ActiveCell.Column - 1).Value = -1.
I have not tested either of these so they may have some typos/etc.
The fastest method is to perform manipulations on yoru data in memory only. You can store the range's values in an array, and perform the operations on the array, and then "write" the values back to the worksheet in a single statement. Looping in memory is much faster than looping and writing on the worksheet.
Dim rng as Range
Dim arr as Variant
Dim val as Variant
Dim r as Long, i As Integer
Set rng = Range(Cells(ActiveCell.Row, ActiveCell.Column -1).Address, Cells(5771, ActiveCell.Column).Address)
'store the range values in a variant array:
' this will be of the structure arr(_row#_, _column#_)
arr = rng.Value
For r = 1 to UBound(arr, 1) 'Loop until last row in range/array
'arr(r,1) represents the first column of the range -- i.e., the column to left of ActiveCell
' so we can use a Case statement to check this value of either 0, 1, or -1.
Select Case arr(r, 1)
Case 0
'if the adjacent left cell = 0 AND this cell's value = ""
' then make this cell's value = 0.
If arr(r, 2) = "" Then arr(r, 2) = 0
Case 1, -1
For i = 0 to 10
'if the value is 1 or -1, puts the in this cell AND the next 9 cells
arr(r + i, 2) = arr(r, 1)
Next
'increment our iterator variable
r = r + 9
Case Else
'Do nothing...
End Select
Next
'put the transformed values in to the worksheet
rng.Value = arr
That is basically the same as this, which uses the worksheet object/cells in the loop. It more closely resembles your loop, but it will also be less efficient than the above.
'Alternatively, but this will be slower:
Dim rng as Range
Dim cl as Range
Dim i as Integer
Set rng = Range(Cells(ActiveCell.Row, ActiveCell.Column -1).Address, Cells(5771, ActiveCell.Column).Address)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For each cl in rng.Cells
With cl
Select Case .Offset(0, -1).Value
Case 0
If .Value = "" Then .Value = 0
Case 1, -1
.Resize(10,1).Value = .Offset(0, -1).Value
Case Else
'Do nothing
End Select
End With
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic