formatting cells

[ockie]

Hi,
seeking help on my following problem
I am trying to color a cell eg A1. if there is a value in B1, C1 etc A1 will turn yellow. but as soon as there is no value in a cell eg D1 A1 reverts to normal. In summary A1 will be highlighted as long as the is a value in B1:Z1
thanks robert

 

[Trebor76]

If I've understood correctly (big if here) you need code to do this so remove the conditional formatting and try this event macro on the sheet in question (i.e. don't put it in a standard module but on the actual sheet):

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'If the entry just made is within columns B to Z (inclusive), then...
    If Target.Column >= 2 And Target.Column <= 26 Then
        'If there are no blanks from Col. B up and including the column where the entry was just made, then...
        If Evaluate("COUNTBLANK(B" & Target.Row & ":" & Split(Target.Address, "$")(1) & Target.Row & ")") = 0 Then
            '...colour Col. A of the row just updated yellow
            Range("A" & Target.Row).Interior.Color = vbYellow
        'Else...
        Else
            '...remove the fill colour from Col. A of the row just updated as there's a gap of data being entered sequentially
            Range("A" & Target.Row).Interior.Color = xlNone
        End If
    End If
  
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

 

[ockie]

thank you for your time trebor, i'll have a go with this, it is way above my knowledge base of macros.

 

[Trebor76]

In case you don't know follow these four steps to install the macro:

1. Select all lines of the macro an copy it to the clipboard (Ctrl + C)
2. Right click on the tab you want the code to run and from the short-cut menu click View Code
3. Paste (Ctrl + V) the macro copied from step 1
4. From the File menu click Close and Return to Microsoft Excel

 

[ockie]

Hi Trebor, I have finally got around to trying to get this to work properly which it does perfectly when entering figures manually.
I am using a vlookup formula to populate a column each week and the macro only works for the first row. ( the same if i highlight cells to delete it only removes the color from the first row)
I have a macro to remove the fomulas from the cells and clear any 0's that are there, leaving only a value. but with no success.
any ideas would be greatly appreciated. I hope I have explained it properly
thanks Robert

 

[Trebor76]

I have finally got around to trying to get this to work properly

Gee, my original post is nearly two years old

See how this goes:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ErrTrap

    Dim i As Long, j As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'If the entry just made is within columns B to Z (inclusive), then...
    If Target.Column >= 2 And Target.Column <= 26 Then
        '...check each row and if there are no blanks from Col. B up and including the column where the entry was just made, then...
        j = Range("B:Z").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For i = 1 To j
            If Evaluate("COUNTBLANK(B" & i & ":" & Split(Target.Address, "$")(1) & i & ")") = 0 Then
                '...colour Col. A of the row just updated yellow
                Range("A" & i).Interior.Color = vbYellow
            'Else...
            Else
                '...remove the fill colour from Col. A of the row just updated as there's a gap of data being entered sequentially
                Range("A" & i).Interior.Color = xlNone
            End If
        Next i
    End If
 
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
   
Exit Sub

ErrTrap:

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

Note the calculation of formulas is not captured so if they are set to return a blank it will not register. Converting them to values should do it.

Regards,

Robert

 

[ockie]

Gee, my original post is nearly two years old

See how this goes:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ErrTrap

    Dim i As Long, j As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'If the entry just made is within columns B to Z (inclusive), then...
    If Target.Column >= 2 And Target.Column <= 26 Then
        '...check each row and if there are no blanks from Col. B up and including the column where the entry was just made, then...
        j = Range("B:Z").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For i = 1 To j
            If Evaluate("COUNTBLANK(B" & i & ":" & Split(Target.Address, "$")(1) & i & ")") = 0 Then
                '...colour Col. A of the row just updated yellow
                Range("A" & i).Interior.Color = vbYellow
            'Else...
            Else
                '...remove the fill colour from Col. A of the row just updated as there's a gap of data being entered sequentially
                Range("A" & i).Interior.Color = xlNone
            End If
        Next i
    End If
 
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
  
Exit Sub

ErrTrap:

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

Note the calculation of formulas is not captured so if they are set to return a blank it will not register. Converting them to values should do it.

Regards,

Robert

 

[ockie]

Hi Trebor, thanks for your prompt reply, I was not sure if I would get a response due to the length of time since I last asked. Your VBA code works well and does exactly what I was after, except for when there is a formula in the cells. I am using a Vlookup to extract data from another sheet. it then reads the formula as an entry and colors the cell in col A yellow. I have tried to find a way to clear the contents of values or formulas after they have done their job with no sucess. This is the formula that is in the cells that I wish your VBA code to work =IF($E12="","",IFERROR(VLOOKUP($E12,INDIRECT($N$4),5,0),0)) I hope I have explained my new problem and not made it more complicated. thanks Robert

 

[Trebor76]

Trying commenting out this line...

If Evaluate("COUNTBLANK(B" & i & ":" & Split(Target.Address, "$")(1) & i & ")") = 0 Then

...and replacing it with this:

If Evaluate("COUNTA(B" & i & ":" & Split(Target.Address, "$")(1) & i & ")") = Target.Column - 1 Then

If this still does not meet your needs start a new thread with a link back to this one as I'm out of ideas I'm afraid ?

 

[ockie]

Trebor, changing the line you suggested works, thank very much. I appreciate the effort you have put into assisting me and I'm hoping for once more.
The problem I'm having now, is changing the cells I wish to color,
with the current code its col A, i would like it to be col D
the data col A reads is now from col B to Z, I would like it from N to AG
I tried changing the lines of code to the below, to reflect this and the code does not work, previously with the old code i could change to the below it and it would work.

If Target.Column >= 14 And Target.Column <= 33 Then
j = Range("n:ag").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If Evaluate("COUNTA(n" & i & ":" & Split(Target.Address, "$")(1) & i & ")") = Target.Column - 1 Then
Range("d" & i).Interior.Color = vbYellow
Range("d" & i).Interior.Color = xlNone

thanks Robert

 

[Trebor76]

Try this:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ErrTrap

    Dim i As Long, j As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'If the entry just made is within columns N to AG (inclusive), then...
    If Target.Column >= 14 And Target.Column <= 33 Then
        '...check each row and if there are no blanks from Col. N up and including the column where the entry was just made (up to Col. AG), then...
        j = Range("N:AG").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For i = 1 To j
            If Evaluate("COUNTA(N" & i & ":" & Split(Target.Address, "$")(1) & i & ")") = (Target.Column - 14) + 1 Then
                '...colour Col. D of the row just updated yellow
                Range("D" & i).Interior.Color = vbYellow
            'Else...
            Else
                '...remove the fill colour from Col. D of the row just updated as there's a gap of data being entered sequentially
                Range("D" & i).Interior.Color = xlNone
            End If
        Next i
    End If
 
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
   
Exit Sub

ErrTrap:

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub