VBA If Row then Value

[Pinaceous]

Good Day,

I'm trying to create a vba sub where if the row contains values across its Columns B, C, D, E and if that row's column F is blank then it gets a highlighted red cell.

If the values across its row for Columns B, C, D, E are missing then there will be no highlighted red cell for its Column F.

Once a value is placed in that highlighted red cell then the highlighted red cell will disappear.




Please let me know, if you need any help!

Thank you,
pinaceous

 

[eiloken]

try this, i don't test it yet but you can feedback to me:

Sub test2()
    Dim xCll As Range
    Dim xRng As Range
    Dim Lr As Long
    Dim i As Integer
    Dim xCond As Boolean
    Lr = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    Set xRng = ActiveSheet.Range("B2:B" & Lr)
    For Each xCll In xRng
        For i = 0 To 3 'loop for each cell in column B to E to find empty cell
            If IsEmpty(xCll.Offset(, i)) Then
                xCond = True
            Else
                xCond = False
            End If
        Next i
        If xCond = False And IsEmpty(xCll.Offset(, 4)) Then 'condition when not found empty cell in same row and cell in column F is empty
            xCll.Offset(, 4).Interior.Color = RGB(255, 0, 0)
        esle
            xCll.Offset(, 4).Interior.Pattern = xlNone
        End If
    Next xCll
End Sub

 

[eiloken]

try this, i don't test it yet but you can feedback to me:

Sub test2()
    Dim xCll As Range
    Dim xRng As Range
    Dim Lr As Long
    Dim i As Integer
    Dim xCond As Boolean
    Lr = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    Set xRng = ActiveSheet.Range("B2:B" & Lr)
    For Each xCll In xRng
        For i = 0 To 3 'loop for each cell in column B to E to find empty cell
            If IsEmpty(xCll.Offset(, i)) Then
                xCond = True
            Else
                xCond = False
            End If
        Next i
        If xCond = False And IsEmpty(xCll.Offset(, 4)) Then 'condition when not found empty cell in same row and cell in column F is empty
            xCll.Offset(, 4).Interior.Color = RGB(255, 0, 0)
        esle
            xCll.Offset(, 4).Interior.Pattern = xlNone
        End If
    Next xCll
End Sub

and then insert this code to the sheet that containt your data, this sub will detect when you enter data to range B to F and run sub "test2" to change cell fill color:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRng As Range
    Dim Lr As Long
    Lr = Me.Cells(Rows.Count, 1).End(xlUp).Row
    Set xRng = Me.Range("B2:F" & Lr)
    If Not Intersect(Target, xRng) Is Nothing Then
        Call test2
    End If
End Sub

 

[Pinaceous]

Wow eiloken!

Many thanks for providing your codes! They look fantastic! Let me try them out according to your instructions and provide some feedback.

Thanks again!
Pinaceous

 

[eiloken]

Wow eiloken!

Many thanks for providing your codes! They look fantastic! Let me try them out according to your instructions and provide some feedback.

Thanks again!
Pinaceous

yeah, but my code above will run for all the cells for each time you change value in modify range so when you have large data it will run so slow, so i recomment change it like this:

Sub test2(ByVal xCll As Range) 'this sub change color for single row
    Dim i As Integer
    Dim xCond As Boolean
    For i = 0 To 3 'loop for each cell in column B to E to find empty cell
        If IsEmpty(xCll.Offset(, i)) Then
            xCond = True
        Else
            xCond = False
        End If
    Next i
    If xCond = False And IsEmpty(xCll.Offset(, 4)) Then 'condition when not found empty cell in same row and cell in column F is empty
        xCll.Offset(, 4).Interior.Color = RGB(255, 0, 0)
    esle
        xCll.Offset(, 4).Interior.Pattern = xlNone
    End If
End Sub

Sub test3() 'this sub will loop through all cell to rechange all fill color
    Dim Lr As Long
    Dim xCll As Range
    Dim xRng As Range
    Lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Set xRng = ActiveSheet.Range("B2:B" & Lr)
    For Each xCll In xRng
        Call test2(xCll)
    Next xCll
End Sub

and then change the code with event change to detect when you change value in row:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRng As Range
    Dim Lr As Long
    Lr = Me.Cells(Rows.Count, 1).End(xlUp).Row
    Set xRng = Me.Range("B2:F" & Lr)
    If Not Intersect(Target, xRng) Is Nothing Then
        Call test2(Me.Range("B" & Target.Row))
    End If
End Sub

 

[Pinaceous]

Hey eiloken!

That last set of codes really works very smoothly!

I've noticed that after the code is ran and the highlighted red cell appears that it can be deleted, which will then leave a blank cell entry.

Could you make it so that a highlighted red cell cannot be deleted only unless a value is entered into it?


Thanks so much very exciting!
pinaceous

 

[Pinaceous]

Ah wait! I had my sheet codes mixed up. Your code actually does not delete as above because I had another running code upon the sheet that was messing it up!
Its good!

 

[Pinaceous]

Hey eiloken!

The only thing if possible that I'd like for you to add to your code is that when the highlighted cell appears; could it contain a number value for example; 123?

Where if any value entered including 123 by the user will make the highlighted cell then disappear?

Please let me know!
Thanks,
pinaceous

 

[eiloken]

Hey eiloken!

That last set of codes really works very smoothly!

I've noticed that after the code is ran and the highlighted red cell appears that it can be deleted, which will then leave a blank cell entry.

Could you make it so that a highlighted red cell cannot be deleted only unless a value is entered into it?


Thanks so much very exciting!
pinaceous

i don't really understand what you meaning but it you mean that the highlighted cell can be change to no color then i recommend create a button for sub test3, it will refill all the cells and highlight it

Sub test3() 'this sub will loop through all cell to rechange all fill color
application.screenupdating=false
application.displayalerts=false
    Dim Lr As Long
    Dim xCll As Range
    Dim xRng As Range
    Lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Set xRng = ActiveSheet.Range("B2:B" & Lr)
    For Each xCll In xRng
        Call test2(xCll)
    Next xCll
application.screenupdating=true
application.displayalerts=true
End Sub

 

[eiloken]

Hey eiloken!

The only thing if possible that I'd like for you to add to your code is that when the highlighted cell appears; could it contain a number value for example; 123?

View attachment 99339

Where if any value entered including 123 by the user will make the highlighted cell then disappear?

Please let me know!
Thanks,
pinaceous

you can edit sub test2 like this:

Sub test2(ByVal xCll As Range) 'this sub change color for single row
    Dim i As Integer
    Dim xCond As Boolean
    For i = 0 To 3 'loop for each cell in column B to E to find empty cell
        If IsEmpty(xCll.Offset(, i)) Then
            xCond = True
        Else
            xCond = False
        End If
    Next i
    If xCond = False And InStr(xCll.Offset(, 4).Value, "123") = 0 Then
        If IsEmpty(xCll.Offset(, 4)) Then 'condition when not found empty cell in same row and cell in column F is empty
            xCll.Offset(, 4).Interior.Color = RGB(255, 0, 0)
        esle
            xCll.Offset(, 4).Interior.Pattern = xlNone
        End If
End Sub