Looping through repeating code

Question

I am using a spreadsheet that brings in real-time prices from tdameritrade into a cell with this formula, =RTD("tos.rtd", , "LAST", B4). Suppose the starting price the formula brings in is $30.00. If the next price the formula brings in goes up to $30.02, the cell color will turn green. If the next price the formula brings in goes down to $30.01, the cell color will turn red. So if it goes up from the previous price, the cell will turn green and if it goes down from the previous price, the cell will turn red. When I attempted to add more results in Cells, B4, B5, B6, B7, I duplicated the code and it's working, however it's not practical to keep adding code as I want thousands of results. Anyone know how to change the code to loop through it as I'm not advanced enough myself but would love to learn how.

Thanks

Sheet Code

 Private Sub Worksheet_Calculate()
      Call updateme
    End Sub

    Private Sub Worksheet_Change(ByVal Target As Range)
      Call updateme
    End Sub


    Private Sub updateme()
      Set cell = ActiveSheet.Range("B4")
      newval = cell.Value
      If newval < lastval Then
        cell.Interior.ColorIndex = 3
      End If
      If newval > lastval Then
        cell.Interior.ColorIndex = 4
      End If
      Set cell2 = ActiveSheet.Range("B5")
      newval2 = cell2.Value
       If newval2 < lastval2 Then
        cell2.Interior.ColorIndex = 3
      End If
      If newval2 > lastval2 Then
        cell2.Interior.ColorIndex = 4
      End If
        Set cell3 = ActiveSheet.Range("B6")
      newval3 = cell3.Value
       If newval3 < lastval3 Then
        cell3.Interior.ColorIndex = 3
      End If
      If newval3 > lastval3 Then
        cell3.Interior.ColorIndex = 4
      End If
          Set cell4 = ActiveSheet.Range("B7")
      newval4 = cell4.Value
       If newval4 < lastval4 Then
        cell4.Interior.ColorIndex = 3
      End If
      If newval4 > lastval4 Then
        cell4.Interior.ColorIndex = 4
      End If
     lastval = newval
     lastval2 = newval2
     lastval3 = newval3
     lastval4 = newval4
    End Sub

**Module Code**

Public lastval As Double
Public lastval2 As Double
Public lastval3 As Double
Public lastval4 As Double

Use a static array of previous values. btw, I'm pretty sure an RTD function doesn't trigger a Worksheet_Change, just a Worksheet_Calculate. — user4039065

Linga Linga · Accepted Answer · 2018-06-12T11:07:42

You can use For while and do while loops

below for loop might help you..!

Private Sub updateme()

Dim cell As Range
' change the start and end range of i as required
For i = 4 To 7
    ' change the column here as required
      Set cell = ActiveSheet.Range("B" & i)
      newval = cell.Value
    
      If newval < lastval Then
        cell.Interior.ColorIndex = 3
      End If
      If newval > lastval Then
        cell.Interior.ColorIndex = 4
      End If
      
     lastval = newval
Next

End Sub

Looping through repeating code

1 Answers