CODEWITHSUNDEEP
vbaexcelloops
LarsS
LarsS

Reputation: 173

Looping through rows and apply different conditional formatting for each row

This script looks up the value in the first column in a row, finds the corresponding value in a second sheet and gets values from the other columns in the same row in the second sheet. Then, it applies conditional formatting on values in the first sheet according to the values retrieved from the second sheet.

However, i can only get it to work on one row at a time, and I don't wish to repeat the code for all the rows in the first sheet. How can I loop through all rows in the first sheet and do the same thing for the remaining rows?

Sub Vlookup4()

Dim FndStr As String
Dim FndVal As Range
Dim FndRng As Range
Dim Ul1 As Double, Ul2 As Double, Ul3 As Double, Ul4 As Double, Ul5 As Double

    FndStr = Range("A10").Value

    Set FndVal = Worksheets("Grenseverdier_jord").Columns("A:A").Find(What:=FndStr, LookAt:=xlWhole)
        Ul1 = FndVal.Offset(0, 1).Value
        Ul2 = FndVal.Offset(0, 2).Value
        Ul3 = FndVal.Offset(0, 3).Value
        Ul4 = FndVal.Offset(0, 4).Value
        Ul5 = FndVal.Offset(0, 5).Value

    Set FndRng = Range(Cells(10, 3), Cells(10, Cells(10, Columns.Count).End(xlToLeft).Column))

    Debug.Print FndRng.Address

    With ActiveSheet

        With FndRng
            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C10);C10<" & Ul1 & ")"
            .FormatConditions(1).Interior.ColorIndex = 33
            .FormatConditions(1).Borders.LineStyle = xlContinuous
            .FormatConditions(1).Borders.Weight = xlThin

            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C10);C10>=" & Ul1 & ";C10<" & Ul2 & ")"
            .FormatConditions(2).Interior.ColorIndex = 4
            .FormatConditions(2).Borders.LineStyle = xlContinuous
            .FormatConditions(2).Borders.Weight = xlThin

            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C10);C10>=" & Ul2 & ";C10<" & Ul3 & ")"
            .FormatConditions(3).Interior.ColorIndex = 6
            .FormatConditions(3).Borders.LineStyle = xlContinuous
            .FormatConditions(3).Borders.Weight = xlThin

            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C10);C10>=" & Ul3 & ";C10<" & Ul4 & ")"
            .FormatConditions(4).Interior.ColorIndex = 45
            .FormatConditions(4).Borders.LineStyle = xlContinuous
            .FormatConditions(4).Borders.Weight = xlThin

            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C10);C10>=" & Ul4 & ";C10<" & Ul5 & ")"
            .FormatConditions(5).Borders.LineStyle = xlContinuous
            .FormatConditions(5).Borders.Weight = xlThin
            .FormatConditions(5).Interior.ColorIndex = 3

            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C10);C10>=" & Ul5 & ")"
            .FormatConditions(6).Interior.ColorIndex = 7
            .FormatConditions(6).Borders.LineStyle = xlContinuous
            .FormatConditions(6).Borders.Weight = xlThin

            .FormatConditions.Add xlExpression, Formula1:="=LEFT(C10;1)=""<"""
            .FormatConditions(7).Interior.ColorIndex = 33
            .FormatConditions(7).Borders.LineStyle = xlContinuous
            .FormatConditions(7).Borders.Weight = xlThin

            .FormatConditions.Add xlExpression, Formula1:="=(C10) = ""n.d."""
            .FormatConditions(8).Interior.ColorIndex = 33
            .FormatConditions(8).Borders.LineStyle = xlContinuous
            .FormatConditions(8).Borders.Weight = xlThin

        End With
        End With
End Sub

I'm attaching a sample file for testing.

Sample file

Upvotes: 0

Views: 548

Answers (1)

Xabier
Xabier

Reputation: 7735

This should do it for you:

Sub Vlookup4()

Dim FndStr As String
'Dim FndVal As Range
Dim FndRng As Range
Dim Ul1 As Double, Ul2 As Double, Ul3 As Double, Ul4 As Double, Ul5 As Double
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A

For i = 10 To LastRow
    FndStr = ws.Range("A" & i).Value

    Set FndVal = Worksheets("Grenseverdier_jord").Columns("A:A").Find(What:=FndStr, LookAt:=xlWhole)
        If Not FndVal Is Nothing Then
                Ul1 = FndVal.Offset(0, 1).Value
                Ul2 = FndVal.Offset(0, 2).Value
                Ul3 = FndVal.Offset(0, 3).Value
                Ul4 = FndVal.Offset(0, 4).Value
                Ul5 = FndVal.Offset(0, 5).Value

            Set FndRng = ws.Range("C" & i & ":I" & i)

            With ActiveSheet

                With FndRng

                    .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C " & i & ");C " & i & "<" & Ul1 & ")"
                    .FormatConditions(1).Interior.ColorIndex = 33
                    .FormatConditions(1).Borders.LineStyle = xlContinuous
                    .FormatConditions(1).Borders.Weight = xlThin

                    .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C " & i & ");C " & i & ">=" & Ul1 & ";C " & i & "<" & Ul2 & ")"
                    .FormatConditions(2).Interior.ColorIndex = 4
                    .FormatConditions(2).Borders.LineStyle = xlContinuous
                    .FormatConditions(2).Borders.Weight = xlThin

                    .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C " & i & ");C " & i & ">=" & Ul2 & ";C " & i & "<" & Ul3 & ")"
                    .FormatConditions(3).Interior.ColorIndex = 6
                    .FormatConditions(3).Borders.LineStyle = xlContinuous
                    .FormatConditions(3).Borders.Weight = xlThin

                    .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C " & i & ");C " & i & ">=" & Ul3 & ";C " & i & "<" & Ul4 & ")"
                    .FormatConditions(4).Interior.ColorIndex = 45
                    .FormatConditions(4).Borders.LineStyle = xlContinuous
                    .FormatConditions(4).Borders.Weight = xlThin

                    .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C " & i & ");C " & i & ">=" & Ul4 & ";C " & i & "<" & Ul5 & ")"
                    .FormatConditions(5).Borders.LineStyle = xlContinuous
                    .FormatConditions(5).Borders.Weight = xlThin
                    .FormatConditions(5).Interior.ColorIndex = 3

                    .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C " & i & ");C " & i & ">=" & Ul5 & ")"
                    .FormatConditions(6).Interior.ColorIndex = 7
                    .FormatConditions(6).Borders.LineStyle = xlContinuous
                    .FormatConditions(6).Borders.Weight = xlThin

                    .FormatConditions.Add xlExpression, Formula1:="=LEFT(C " & i & ";1)=""<"""
                    .FormatConditions(7).Interior.ColorIndex = 33
                    .FormatConditions(7).Borders.LineStyle = xlContinuous
                    .FormatConditions(7).Borders.Weight = xlThin

                    .FormatConditions.Add xlExpression, Formula1:="=(C " & i & ") = ""n.d."""
                    .FormatConditions(8).Interior.ColorIndex = 33
                    .FormatConditions(8).Borders.LineStyle = xlContinuous
                    .FormatConditions(8).Borders.Weight = xlThin
                End With
            End With
        End If
Next i
End Sub

I've added a line to find the LastRow and then used a For Loop to loop through each row, I've also added If Not FndVal Is Nothing Then to make sure that if nothing is found on the other sheet it doesn't cause an error.

Upvotes: 1

Related Questions