Mike Mc
Mike Mc

Reputation: 23

Comparing cells in a loop with VBA

I was asked to write a quick macro in VBA for comparing the values in two different cells in an Excel spreadsheet, then changing one of the cells red if the value was less than the other. I was able to do this for one set of cells, but have not figured out how to do this for multiple cells. In my macro, I'm comparing "E37" with "C40". I need to do this same comparison with "E44" and "C47", etc., each time I'm moving down 7 rows for each value. I also need a command to stop the routine if the cells are blank since not all of our spreadsheets are the same length.

I've already gotten a macro that executes this macro each time a value is entered into the spreadsheet. I assigned it at the sheet level, just need to find a way to keep comparing the cells. Please see code below.

Sub colorcellMacro()
    '
    ' colorcellMacro Macro
    ' change background color according to ref length
    '

    Range("E37").Select
    If Range("E37") < Range("C40") Then
         Range("E37").Select
         With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
            .PatternTintAndShade = 0
             Range("H24").Select
         End With
    Else
        Range("E37").Select
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If
End Sub

This is what I ended up using, it's a combination of the two suggestions.

'Sub colorcellMacro()
'
' colorcellMacro Macro
' change background color according to ref length
'

'
Dim firstIndex, secIndex As Integer

firstIndex = 37
secIndex = 40

Do While Range("E" & firstIndex).Value <> "" And Range("C" & secIndex).Value <> ""
    If Range("E" & firstIndex).Value < Range("C" & secIndex).Value Then
         Range("E" & firstIndex).Select
         With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
            .PatternTintAndShade = 0
            Range("H24").Select
        End With
Else
    Range("E" & firstIndex).Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End If
firstIndex = firstIndex + 7
secIndex = secIndex + 7

Loop

End Sub

Upvotes: 2

Views: 8128

Answers (2)

fgalvao
fgalvao

Reputation: 460

this should work. I included the coloring code that you informed:

Sub colorCellMacro()

Dim firstRow As Integer
Dim secondRow As Integer

firstRow = 37
secondRow = 40

Do While Cells(firstRow, 5) <> "" And Cells(secondRow, 3) <> ""
    If Cells(firstRow, 5).Value < Cells(secondRow, 3).Value Then
         Cells(firstRow, 5).Select
         With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
            .PatternTintAndShade = 0
             Range("H24").Select
         End With
    Else
        Cells(firstRow, 5).Select
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If
    firstRow = firstRow + 7
    secondRow = secondRow + 7
Loop

End Sub

Upvotes: 0

Constuntine
Constuntine

Reputation: 508

Dim firstIndex, secIndex as Integer

firstIndex = 37
secIndex = 40

while Range("E" & firstIndex).Value <> "" and Range("C" & secIndex).value <> "" Then
    ` Do the comparison here
    ` Change the color here
    firstIndex = firstIndex + 7
    secIndex = secIndex + 7
next

Try this. If this doesn't work it will be something like this or close to it.

Upvotes: 1

Related Questions