2

My VBA code in excel is running very slowly. How could I make this macro code to run faster?

Sub Test()
Dim i As Long

For i = 1 To Rows.Count
Statusupdate = Cells(i, 1).Value

If Status = "Started" And IsEmpty(Cells(i, 11).Value) = True Then
Cells(i, 11).Value = Format(Now, "dd-mm-yy HH:mm")

ElseIf Status = "Finished team A" And IsEmpty(Cells(i, 12).Value) = True Then
Cells(i, 12).Value = Format(Now, "dd-mm-yy HH:mm")

ElseIf Status = "Started team B" And IsEmpty(Cells(i, 13).Value) = True Then
Cells(i, 13).Value = Format(Now, "dd-mm-yy HH:mm")

ElseIf Status = "Finished team b" And IsEmpty(Cells(i, 14).Value) = True Then
Cells(i, 14).Value = Format(Now, "dd-mm-yy HH:mm")

ElseIf Status = "Review" And IsEmpty(Cells(i, 15).Value) = True Then
Cells(i, 15).Value = Format(Now, "dd-mm-yy HH:mm")

ElseIf Status = "Review finished" And IsEmpty(Cells(i, 16).Value) = True Then
Cells(i, 16).Value = Format(Now, "dd-mm-yy HH:mm")

ElseIf Status = "Finished" Then
Cells(i, 17).Value = Format(Now, "dd-mm-yy HH:mm")

End If
Next i
Application.ScreenUpdating = False
End Sub
New contributor
Ole B. is a new contributor to this site. Take care in asking for clarification, commenting, and answering. Check out our Code of Conduct.
  • Is it Status or Statusupdate? Dim all of your variables and use Option Explicit. – Jeeped Mar 26 at 8:49
2

You could loop through only the rows with a value instead of all 1,048,576 rows of the worksheet.

'change
For i = 1 To Rows.Count
'to
For i = 1 to cells(rows.count, "A").end(xlup).row

Instead of looping through the cells in the worksheet, you could collect the values from column A into an array and store the date values into another array that will be deposited onto the worksheet all at once.

Option Explicit

Sub Test()
    Dim i As Long, arrA As Variant, arrKQ As Variant

    With Worksheets("sheet1")

        arrA = .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp)).Value2
        arrKQ = .Cells(1, "K").Resize(UBound(arrA, 1), 7).Value2

        For i = LBound(arrA, 1) To UBound(arrA, 1)

            Select Case LCase(arrA(i, 1))
                Case "started"
                    If IsEmpty(arrKQ(i, 1)) Then arrKQ(i, 1) = Now
                Case "finished team a"
                    If IsEmpty(arrKQ(i, 2)) Then arrKQ(i, 2) = Now
                Case "started team b"
                    If IsEmpty(arrKQ(i, 3)) Then arrKQ(i, 3) = Now
                Case "finished team b"
                    If IsEmpty(arrKQ(i, 4)) Then arrKQ(i, 4) = Now
                Case "review"
                    If IsEmpty(arrKQ(i, 5)) Then arrKQ(i, 5) = Now
                Case "review finished"
                    If IsEmpty(arrKQ(i, 6)) Then arrKQ(i, 6) = Now
                Case "finished"
                    arrKQ(i, 7) = Now
                Case Else
                    'do nothing (placeholder for future options)
            End Select

        Next i

        With .Cells(1, "K").Resize(UBound(arrKQ, 1), UBound(arrKQ, 2))

            .Value2 = arrKQ
            .NumberFormat = "dd-mm-yy hh:mm"

        End With

    End With

End Sub

Your Answer

Ole B. is a new contributor. Be nice, and check out our Code of Conduct.

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.