macro takes too long

[kylefoley76]

This macro is taking about 1 second to loop through just 1 iteration and it is a very simple macro. With about 700 interations it will take more than 11 minutes.

What is wrong?

Sub dates()


Dim thedate As Date


thedate = ActiveCell.Offset(-1).Value
Dim i As Integer
Application.ScreenUpdating = False




Do Until ActiveCell.Offset(0, 1) = ""
i = i + 1




    If ActiveCell.Offset(0, 2).Value <> "x" Then
    ActiveCell = thedate
    Else
    thedate = thedate + 1
    ActiveCell = thedate
    End If
ActiveCell.Offset(1).Select




Loop


Application.ScreenUpdating = True


End Sub

 

[Michael M]

Hi Kyle
Simple way would be to stop Selecting and using ActiveCell
Instead try using a for Next and referencing the cell rather than selecting it.
BTW....what is the i variable used for ?

 

[Smitty]

Or AutoFilter on x, then apply a change to the visible rows.

 

[kylefoley76]

I'm not very familiar with the syntax for cells. How do I reference the activecell without calling it the activecell?

 

[Smitty]

I'm not very familiar with the syntax for cells. How do I reference the activecell without calling it the activecell?

One of the problems using ActiveCell is that you don't always know what it is.

Michael was referring to something like this:

Dim lr as Long
Dim i as Long

  lr = Cells(Rows.Count,"A").End(xlUp).Row
  
  For i = 1 to lr
    Cells(i,"A")... ' Do your thing here
  Next i

 

[kylefoley76]

ok, i stopped selected the activecell but things are still taking way too long. it takes 93 seconds to run through 55 iterations

Dim thedate As Date
Dim current_cell As Long
Dim f As Single
f = Timer()




current_cell = Range("e65000").End(xlUp).Row




thedate = Range("e" & current_cell).Value
Dim i As Integer
Application.ScreenUpdating = False






Do Until Range("f" & current_cell).Value = ""
i = i + 1
If i = 900 Then
End
End If






    If Range("g" & current_cell).Value <> "x" Then
    Cells(current_cell, "e").Value = thedate
    Else
    thedate = thedate + 1
    Cells(current_cell, "e").Value = thedate
    End If
current_cell = current_cell + 1




Loop


Application.ScreenUpdating = True
MsgBox "ET: " & Format(Timer - f, "0.000") & "s"


End Sub

 

[kylefoley76]

Ok, I looked at another page and they recommended using the with feature. I did that and it still took me 28 seconds to loop through 15 cells.

Dim thedate As Date
Dim current_cell As Long
Dim f As Single
f = Timer()




current_cell = Range("e65000").End(xlUp).Row


Dim stop_working As Long
stop_working = Range("f65000").End(xlUp).Row - 1


thedate = Range("e" & current_cell).Value
Dim i As Integer
Application.ScreenUpdating = False


With Sheets("time")


For k = current_cell To stop_working
i = i + 1
If i = 900 Then
End
End If


    If .Range("g" & current_cell).Value <> "x" Then
    .Cells(current_cell, "e").Value = thedate
    Else
    thedate = thedate + 1
    .Cells(current_cell, "e").Value = thedate
    End If
    current_cell = current_cell + 1


Next


End With


Application.ScreenUpdating = True
MsgBox "ET: " & Format(Timer - f, "0.000") & "s"

 

[Andrew Poulsom]

Maybe you need to set Calculation to manual, or disable some event(s) that may be firing.

 

[kylefoley76]

Ok, I've done some research and I learned that you're not supposed to loop over ranges and that you're supposed to put the ranges in an array. I don't really understand this but I did try putting the cells into an array and using the for each feature. It still seems like I'm looping over ranges because whenever a step into the function it still noticeably takes a very long time to cross over the rng part of the code. My second problem is that none of the values are getting published on the screen. My third problem is that I'm getting a type mismatch with thedate. My fourth problem is that I don't understand the difference betwene value and value2.

Sub dates()


Dim thedate
Dim current_cell As Long
Dim f As Single
f = Timer()
Dim rng As Range, rng2 As Range


current_cell = Range("e65000").End(xlUp).Row


Dim done As Long
done = Range("f65000").End(xlUp).Row - 1


Set rng = Range("g" & current_cell, "g" & done)
Set rng2 = Range("e" & current_cell, "e" & done)


thedate = Format(thedate, Date)
thedate = rng2.Value
'thedate = rng2.Value
Dim i As Integer
i = 7
'Application.ScreenUpdating = False


'With Sheets("time")


For Each cell In rng






    If cell.Value <> "x" Then
    rng2.Value = thedate
    Else
    thedate = thedate + 1
    rng2.Value = thedate
    End If
    


Next


'End With


'Application.ScreenUpdating = True
MsgBox "ET: " & Format(Timer - f, "0.000") & "s"


End Sub

 

[shg]

Can you explain in words what the code is supposed to do?