Loops works, but causes program to freeze

Question

I have this small piece of code.

Sub FillRemainingDates()
    

    Dim SearchRange As Range
    Set SearchRange = Sheets(1).UsedRange.Columns(11)

    Dim cell As Range

    
    For Each cell In SearchRange
        
        If cell.Value = vbNullString And cell.Offset(0, 9).Value = cell.Offset(1, 9).Value Then
            cell = cell.Offset(1, 0).Value
        End If

    Next
    

End Sub

Its goal is to attribute a value to a cell in a column depending on the value of a cell a row below:

The macro "works" in the sense that it does what I expect it to do, but whenever I run it it causes the program to become unresponsive and freeze for a long time.

I think I'm missing something in the loop and it's causing the program to fall into an infinite loop or have to deal with more data than necessary.

There is nothing in the posted code that would obviously take a lot of time. How big is the used range? Perhaps in the column that you search in you are iterating below the used cells in that column. [How To Speed Up VBA Code](https://stackoverflow.com/q/47089741/4996248) might help. — John Coleman, Jan 26 '23 at 12:02
@JohnColeman The range is around 5000 rows. I will try out the tips from that post, thanks! — maliebina, Jan 26 '23 at 12:06

score 1 · Answer 1 · answered Jan 26 '23 at 12:12

You should use an array to work on - and then write that back to the sheet.

Sub FillRemainingDates()
    
    'ASSUMPTION: data start in column A
    
    '>>> change the names according to your project
    Const colNameOfColumn11 As Long = 11
    Const colNameOfColumn20 As Long = 20

    Dim arrSearch As Variant
    arrSearch = Worksheets(1).UsedRange
    
    Dim i As Long
    Dim varValue As Variant  '>>>> change type according to your values
    
    For i = 1 To UBound(arrSearch, 1) - 1   ' don't check last row
        varValue = arrSearch(i, colNameOfColumn11)
        
        If varValue = vbNullString And _
            arrSearch(i, colNameOfColumn20) = arrSearch(i + 1, colNameOfColumn20) Then
            
            arrSearch(i, colNameOfColumn11) = arrSearch(i + 1, colNameOfColumn11)
        End If
    Next

    Worksheets(1).UsedRange.Value = arrSearch

End Sub

Loops works, but causes program to freeze

1 Answers1