VBA If Row then Value

Pinaceous

Well-known Member
Joined
Jun 11, 2014
Messages
1,124
Office Version
  1. 365
Platform
  1. Windows
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.

Capture.jpg



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
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
try this, i don't test it yet but you can feedback to me:
VBA Code:
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
 
Upvote 1
try this, i don't test it yet but you can feedback to me:
VBA Code:
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:
VBA Code:
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
 
Upvote 1
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
 
Upvote 0
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:
VBA Code:
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:
VBA Code:
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
 
Upvote 0
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
 
Last edited:
Upvote 0
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!
 
Upvote 0
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?

Capture1.jpg


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

Please let me know!
Thanks,
pinaceous
 
Upvote 0
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
VBA Code:
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
 
Upvote 0
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:
VBA Code:
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
 
Upvote 1

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top