Speeding up VBA Macro with multiple 'For' and 'if' statements - vba

Question

This macro takes 2+ minutes to run. What are the best methods to optimize the macro?
Sub Time_Color(z, k)
Application.DisplayAlerts = False
For Each cell In Sheet1.Range("C" & z & ":" & "LZ" & z)
If cell.Value <> "x" Then
If cell.Value < Sheet3.Range("D" & k) Then
cell.Interior.ColorIndex = 37
cell.Offset(1, 0).Value = Sheet4.Range("D" & k).Value & "_" & Sheet4.Cells(k, 5).Value
End If
For j = 5 To 1000 Step 2
If cell.Value > Sheet3.Cells(k, j).Value And cell.Value < Sheet3.Cells(k, j + 1).Value Then
cell.Interior.ColorIndex = 37
cell.Offset(1, 0).Value = Sheet4.Cells(k, j + 1).Value & "_" & Sheet4.Cells(k, j + 2).Value
End If
Next j
For j = 4 To 1000 Step 2
If cell.Value >= Sheet3.Cells(k, j).Value And cell.Value <= Sheet3.Cells(k, j + 1).Value Then
cell.Interior.ColorIndex = 43
cell.Offset(1, 0).Value = Sheet4.Cells(k, j).Value & "_" & Sheet4.Cells(k, j + 1).Value
End If
Next j
End If
Next cell
Application.DisplayAlerts = True
End Sub
I am running this macro for 24 different combinations of z,k.

Answer 1

Try caching as much data as possible, for instance Sheet3.Range("D" & k) is constant throughout this function.
Every instance of the inner most loop will query that cell. If you put it at the beginning of this function, it will be looked up once and then used for the remainder of the function.
Edit:
In the comments on this question is - I think - a better answer by Tim Williams, which is specific to VBA:
Turn off ScreenUpdating and Calculation while running. Calculation
should be reset before your Sub ends (ScreenUpdating will reset
itself)

Answer 2

I'm not entirely sure what you are trying to accomplish, but it seems that your loop iterates over a large range to find the last-most instance of a cell that satisfies one of the two given criteria (your two loops).
If that is the goal, why not start from the back? Depending on how your sheet looks, this is potentially a lot faster!
I also made some other changes. Let me know how it works.
Take care to also include the function at the bottom (heisted from this answer), or substitute it for your function of choice.
Sub Time_Color(z, k)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim loopVal, loopVal2, loopVal3 As Variant
Dim setOdd, setEven, OddEven As Boolean
Dim compVal, compVal2, compVal3 As Variant
compVal = Sheet3.Range("D" & k).Value
compVal2 = Sheet4.Range("D" & k).Value
compVal3 = Sheet4.Cells(k, 5).Value
For Each cell In Sheet1.Range("C" & z & ":" & "LZ" & z)
If cell.Value <> "x" Then
If cell.Value < compVal Then
cell.Interior.ColorIndex = 37
cell.Offset(1, 0).Value = compVal2 & "_" & compVal3
End If
For j = 1000 To 4 Step -1
loopVal = Sheet3.Cells(k, j).Value
loopVal2 = Sheet3.Cells(k, j + 1).Value
loopVal3 = Sheet4.Cells(k, j + 1).Value
OddEven = OddOrEven(j)
If OddEven = True Then
If cell.Value > loopVal And cell.Value < loopVal2 Then
cell.Interior.ColorIndex = 37
cell.Offset(1, 0).Value = loopVal3 & "_" & Sheet4.Cells(k, j + 2).Value
setOdd = True
End If
Else
If cell.Value >= loopVal And cell.Value <= loopVal2 Then
cell.Interior.ColorIndex = 43
cell.Offset(1, 0).Value = Sheet4.Cells(k, j).Value & "_" & loopVal3
setEven = True
End If
End If
If setEven = True And setOdd = True Then Exit For
Next j
End If
Next cell
Application.DisplayAlerts = True
End Sub
Function OddOrEven(a As Integer) As Boolean ' Returns TRUE if a is an odd number
If a - (2 * (Fix(a / 2))) <> 0 Then OddOrEven = True
End Function