How to fix long run times replacing values - excel

Question

I have a spreadsheet with approx. 45,000 rows. Currently I am looping through a column and targeting any cells with a value of 0. Those row numbers get stored in an array. I am then looping through that array, and changing another cell based on the array value. I have 5000 rows with values that need to be reassigned, and it is taking over an hour to run that segment of the code (saving the row numbers to the array only takes a few seconds). Any ideas on how to get the code to run faster? Here is the code:
'Initialize array
Dim myArray() As Variant
Dim x As Long
'Looks for the last row on the "Dates" sheet
Dim lastRow As Long
With ThisWorkbook.Sheets("Dates")
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
End With
Dim i As Integer
i = 2
Dim uCounter As Integer
'Loop through all the dates on the "Dates" sheet
While i <= lastRow
'Each date has a counter next to it
uCounter = Worksheets("Dates").Range("B" & i).Value
Dim uDate As String
'Store the date as a string
uDate = Worksheets("Dates").Range("C" & i).Value
Dim startRow As Long, endRow As Long
'Finds the first and last instance of the date on the CERF Data page (45,000 rows)
With Sheets("CERF Data")
startRow = .Range("AN:AN").Find(what:=uDate, after:=.Range("AN1"), LookIn:=xlValues).Row
endRow = .Range("AN:AN").Find(what:=uDate, after:=.Range("AN1"), LookIn:=xlValues, searchdirection:=xlPrevious).Row
End With
Dim j As Long
For j = startRow To endRow
'If the cell in column BB is 0, and the counter is above 0 save row number to array, j being the variable representing row number
If Sheets("CERF Data").Range("BB" & j).Value = 0 And uCounter > 0 Then
'save row number to array
ReDim Preserve myArray(x)
myArray(x) = j
x = x + 1
'decrement counter by 1
uCounter = uCounter - 1
End If
If uCounter = 0 Then Exit For
Next j
i = i + 1
Wend
Dim y As Long
'Loop through the array and assign a value of 2 to all the rows in the array for column AS
For y = LBound(myArray) To UBound(myArray)
Sheets("CERF Data").Range("AS" & myArray(y)).Value = 2
Next y
Thanks!

Answer 1

Without more info this is what I can get you:
Just 1 loop through all the rows, once, checking both if the value on column BB = 0 and the date is within your range of dates:
Option Explicit
Sub Test()
Dim arr, i As Long, DictDates As Scripting.Dictionary
arr = ThisWorkbook.Sheets("CERF Data").UsedRange.Value
Set DictDates = New Scripting.Dictionary 'You need the Microsoft Scripting Runtime Reference for this to work
'Create a dictionary with all the dates you must check
With ThisWorkbook.Sheets("Dates")
LastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
For i = 2 To LastRow
If Not DictDates.Exists(CDate(.Cells(i, 3))) Then DictDates.Add CDate(.Cells(i, 3)), 1
Next i
End With
'Only one loop through the whole array
For i = 1 To UBound(arr)
If arr(i, 54) = 0 And DictDates.Exists(CDate(arr(i, 40))) Then 'check your 2 criterias, date and value = 0
arr(i, 45) = 2 'input the value 2 on the column "AS"
End If
Next i
ThisWorkbook.Sheets("CERF Data").UsedRange.Value = arr
End Sub