VBA enter value adjacent cell changes color

[Pinaceous]

Hi All,

I'm working with a column I11:I180; where if a value is entered into this column, I'd like the adjacent cell to turn red until a value is entered into that cell.

For example, if I enter a value into cell I11, the cell H11 will turn red until a value is entered here.

Likewise, if I enter in a value into cell I12, the cell H12 will turn red until a value is entered here and so on until cell I180 of that column.

I'd prefer to use a VBA code in lieu of data validation option.

Can you help me figure this out?

Thank you!
pinaceous

 

[BSALV]

or you delete the "option Explicit" as 1st line of the module (normally i don't declare variables)
or you add ",cl,b" after the "dim"

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
     Dim c     As Range, cl, b
     ....

 

[Pinaceous]

or you delete the "option Explicit" as 1st line of the module (normally i don't declare variables)
or you add ",cl,b" after the "dim"

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
     Dim c     As Range, cl, b
     ....

Okay, I see thanks BSALV!

BTW, can how would I add a value to the red cell?

For example, "Enter KG" will appear into the red cell when it changes color?

Again, thanks so much!!!

PS. Also is there a way to use "Option Explicit" with your code?

 

[BSALV]

i explain the 2 OR's :
* if you remain "option explicit", then add cl and b in that dim line, because they have to be declared.
To be 100% perfect and line per line it 'd be like
dim c as range
dim cl as range
dim b as boolean
* if you delete "option explicit", then the problem is also solved, because the variables don't need declaration anymore.

 

[BSALV]

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim c     As Range
     Set c = Intersect(Target, Range("H11:I80"))                'just check the changes in range H11:I80
     If Not c Is Nothing Then                                   'nothing changed in that range
          Set c = Intersect(c.EntireRow, Range("H11:H80"))      'for those changed cells look always in the H-column even if you changed the I-column
          For Each cl In c.Cells
               b = ((cl.Value = "" Or cl.Value = "Enter KG") And cl.Offset(, 1).Value <> "")     'H is red when it's empty or "Enter KG" and I isn't empty
               cl.Interior.Color = IIf(b, RGB(255, 0, 0), RGB(255, 255, 255))     'give right color to H
               If b And cl.Value = "" Then cl.Value = "Enter KG"     'only add "Enter KG" when H cell is empty (to prevent endless loop)
               If cl.Value = "Enter KG" And cl.Offset(, 1).Value = "" Then cl.Value = "" 'also when I is empty again and H is still "Enter KG", then delete H
          Next
     End If
End Sub

 

[Pinaceous]

Hey BSALV!

Your code that you posted #14 really works fantastic! I'm very impressed!

I just have one additional request and hope that it can be done!

When applying your code onto a sheet table as the picture shows, it is is changing the background color patter of highlighted cells to that table after the value(s) of Column I has been removed by the user.

Do you know if you can kindly change your code around, so that it just clears the contents of the existing cell(s) of Column H in lieu of changing the background as it is structured currently?

Many thanks!
pinaceous

 

[BSALV]

indeed, small mistake, just modify this line

              cl.Interior.Color = IIf(b, RGB(255, 0, 0), xlNone)

 

[Pinaceous]

indeed, small mistake, just modify this line

              cl.Interior.Color = IIf(b, RGB(255, 0, 0), xlNone)

Perfect!!

Many thanks BSALV!

Awesome job!

 

[Pinaceous]

Hi BSALV,

Your code is really working well and am really amazed!

Currently, now I have two codes running upon my sheet in respect to Column H & I.

One code working from H to I and your code working from I to H.

Private Sub ColumnH_ChangeI(ByVal Target As Range)
  Dim Changed As Range, rw As Range
  
  Set Changed = Intersect(Target, Range("H11:I180"))
  If Not Changed Is Nothing Then
    Application.EnableEvents = False
    For Each rw In Intersect(Changed.EntireRow, Columns("H:I")).Rows
      With rw.Cells(1, 2)
        If Not IsEmpty(.Offset(, -1).Value) And IsEmpty(.Value) Then
          .Value = "Enter Tally!"
          .Interior.Color = vbRed
        
        Else
          .Interior.Color = xlNone
          If .Value = "Enter Tally!" Then .ClearContents
        End If
      End With
    Next rw
    Application.EnableEvents = True
  End If
End Sub

Private Sub ColumnI_ChangeH(ByVal Target As Range)
 Dim c As Range
Dim cl As Range
Dim b As Boolean

     Set c = Intersect(Target, Range("H11:I180"))                'just check the changes in range H11:I80
     If Not c Is Nothing Then                                   'nothing changed in that range
          Set c = Intersect(c.EntireRow, Range("H11:H180"))      'for those changed cells look always in the H-column even if you changed the I-column
          For Each cl In c.Cells
               b = ((cl.Value = "" Or cl.Value = "Enter KG") And cl.Offset(, 1).Value <> "")     'H is red when it's empty or "Enter KG" and I isn't empty
               cl.Interior.Color = IIf(b, RGB(255, 0, 0), xlNone)    'give right color to H
               If b And cl.Value = "" Then cl.Value = "Enter KG"     'only add "Enter KG" when H cell is empty (to prevent endless loop)
               If cl.Value = "Enter KG" And cl.Offset(, 1).Value = "" Then cl.Value = "" 'also when I is empty again and H is still "Enter KG", then delete H
          Next
     End If
End Sub

Would you know how I can combine these two codes together in lieu of having them operate separately upon the sheet?

I am attempting to do this but it is not flowing correctly.

Do you have any ideas?

Thanks again,
pinaceous

 

[Pinaceous]

Hi BSALV,

Please disregard the last post.

In working with your code, can you please adjust your code to do the following:

Private Sub ColumnI_ChangeH(ByVal Target As Range)
 Dim c As Range
Dim cl As Range
Dim b As Boolean

     Set c = Intersect(Target, Range("H11:I180"))                'just check the changes in range H11:I80
     If Not c Is Nothing Then                                   'nothing changed in that range
          Set c = Intersect(c.EntireRow, Range("H11:H180"))      'for those changed cells look always in the H-column even if you changed the I-column
          For Each cl In c.Cells
               b = ((cl.Value = "" Or cl.Value = "Enter KG") And cl.Offset(, 1).Value <> "")     'H is red when it's empty or "Enter KG" and I isn't empty
               cl.Interior.Color = IIf(b, RGB(255, 0, 0), xlNone)    'give right color to H
               If b And cl.Value = "" Then cl.Value = "Enter KG"     'only add "Enter KG" when H cell is empty (to prevent endless loop)
               If cl.Value = "Enter KG" And cl.Offset(, 1).Value = "" Then cl.Value = "" 'also when I is empty again and H is still "Enter KG", then delete H
          Next
     End If
End Sub

Where if the value of the Column I cell is deleted, it will also clear the corresponding Column H cells of its contents?

Thank you,
pinaceous

 

[EXCEL MAX]

This code can be some kind of combination two requests.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim vIntersection As Range, vN As Long
    
    With Application
        .Cursor = xlNorthwestArrow
        .EnableEvents = False
        Set vIntersection = Intersect(Range("H11:I180"), Target)
        If Not vIntersection Is Nothing Then
            With vIntersection
                For vN = 1 To .Count
                    If IsEmpty(.Cells(vN)) Then
                        Intersect(vIntersection, .Cells(vN).EntireRow).EntireRow. _
                            Interior.Color = xlNone
                        Intersect(vIntersection, .Cells(vN).EntireRow).EntireRow = ""
                    Else
                        If .Column = 9 Then
                            .Cells(vN).Offset(, -1).Interior.Color = vbRed
                            .Cells(vN).Offset(, -1) = "Enter KG"
                        End If
                    End If
                Next vN
            End With
        End If
        .Cursor = xlDefault
        .EnableEvents = True
    End With
    
End Sub