Fill cell if empty

I think you want something more like this:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range
    If Not Intersect(Target, Range("B2:D2")) Is Nothing Then
   
        Set r = Range("D6:F6")
   
        If Target <> " " Then
            With r
                .Interior.ColorIndex = 3
            End With
        End If
    End If

End Sub


Put this in your sheet code module,

Dave

Sorry - that's Worksheet_Change() instead

Dave

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
    If Not Intersect(Target, Range("B2:D2")) Is Nothing Then
    
        Set r = Range("D6:F6")
    
        If Target <> " " Then
            With r
                .Interior.ColorIndex = 3
            End With
        End If
    End If

End Sub

Select allOpen in new window

Hi there,

Your post is a little confusing as to your exact requirements.  When you talk about your cells being "filled in", do you mean with color, as it looks like that is what you are trying to do in your code?  Or do you mean with a (any) value?  Assuming that you want to color D6:F6 if there is any value in the range of B2:D2, and uncolor if there is no value in that range, then you could use the code posted.

If this doesn't meet your requirements, or you need changes, please post back.

HTH

Option Explicit

Private Const sInputRange   As String = "B2:D2"
Private Const sOutputRange  As String = "D6:F6"
Private Const iColorIndex   As Long = 3

Private Sub Worksheet_Change(ByVal Target As Range)
    
    'Dimension variables
    Dim rCell As Range
    
    'Checks for single cell entry only
    If Target.Cells.Count > 1 Then Exit Sub
    
    'Checks to see if the target cell is in the specified input range
    If Intersect(Target, Me.Range(sInputRange)) Is Nothing Then Exit Sub
    
    'Checks if anything is in the input range
    Select Case WorksheetFunction.CountA(Me.Range(sInputRange))
    
    Case Is = 0
        
        'If not, clear out coloring
        Me.Range(sOutputRange).Interior.ColorIndex = 0
    
    Case Is = 1
    
        'If so, change the color of the output cells
        Me.Range(sOutputRange).Interior.ColorIndex = iColorIndex
    
    Case Else
    
        'More than one value is trying to be entered, clear the entry
        'and give a message
        Application.EnableEvents = False
        Target.ClearContents
        Application.EnableEvents = True
        MsgBox "You can only enter information for one range in " & sInputRange & "!", vbExclamation, "ERROR!"

    End Select
    
End Sub

Select allOpen in new window

Is this what you want?

Dim prevD6Value, prevE6Value, prevF6Value
    
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng1 As Range, Rng2 As Range
    
    Set Rng1 = Range("B2:D2")
    Set Rng2 = Range("D6:F6")
    
    Application.EnableEvents = False
    
    If Not Intersect(Target, Rng1) Is Nothing Then
        '~~~> Code here to fill Rng2
    End If
    
    If Not Intersect(Target, Rng2) Is Nothing Then
        If WorksheetFunction.CountA(Rng1) > 0 Then
            MsgBox "Please note that nothing can be entered in this range"
            Range("D6").Value = prevD6Value
            Range("E6").Value = prevE6Value
            Range("F6").Value = prevF6Value
        End If
    End If
    
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    prevD6Value = Range("D6").Value
    prevE6Value = Range("E6").Value
    prevF6Value = Range("F6").Value
End Sub

Select allOpen in new window

Sid

And to take it a bit further, managing the range input, see below - and attached.

Cheers,

dave

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, fillit As Boolean

    If (Not Intersect(Target, Range("B2:D2")) Is Nothing) Or (Not Intersect(Target, Range("D6:F6")) Is Nothing) Then 'a change made in Range 1 or Range 2
        
        fillit = False
        For Each r In Range("B2:D2") 'is there data in any of this range?
            If r <> "" Then
                fillit = True
            End If
        Next r
        
        If Not Intersect(Target, Range("B2:D2")) Is Nothing Then ' if change is being made in range 1
           
            If fillit Then ' if so then color it
                Range("D6:F6").Interior.ColorIndex = 3
            Else
                Range("D6:F6").Interior.ColorIndex = -4142
            End If
        Else
            If Not Intersect(Target, Range("D6:F6")) Is Nothing Then 'making a change in Range 2 - check if that's ok
                If fillit Then 'there is something in Range 1 - so don't allow this change
                    Application.EnableEvents = False 'so undo doesn't recurse
                    Application.Undo
                    Application.EnableEvents = True
                Else
                    'do nothing
                End If
            End If
        End If
    End If


End Sub

Select allOpen in new window

check-range-input-r1.xlsm

@Usk - you'll want to check each to see if you can copy/paste into the range, acting with > 1 cell change.  Also, I like Sid's approach with global variable on previous value as opposed to my Application.Undo.

Mine also changes the fill color back to nothing, if Range 1 is cleared.

I've updated mine, to revert without the UNDO.

See below & attached,

Dave

Dim prevVals() As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, fillit As Boolean

    If (Not Intersect(Target, Range("B2:D2")) Is Nothing) Or (Not Intersect(Target, Range("D6:F6")) Is Nothing) Then 'a change made in Range 1 or Range 2
        
        fillit = False
        For Each r In Range("B2:D2") 'is there data in any of this range?
            If r <> "" Then
                fillit = True
            End If
        Next r
        
        If Not Intersect(Target, Range("B2:D2")) Is Nothing Then ' if change is being made in range 1
           
            If fillit Then ' if so then color it
                Range("D6:F6").Interior.ColorIndex = 3
            Else
                Range("D6:F6").Interior.ColorIndex = -4142
            End If
        Else
            If Not Intersect(Target, Range("D6:F6")) Is Nothing Then 'making a change in Range 2 - check if that's ok
                If fillit Then 'there is something in Range 1 - so don't allow this change
                    Application.EnableEvents = False 'so undo doesn't recurse
                    Range("D6:F6") = prevVals
                    Application.EnableEvents = True
                Else
                    'do nothing
                End If
            End If
        End If
    End If


End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    prevVals = Range("D6:F6")
End Sub

Select allOpen in new window

check-range-input-r2.xlsm

Great seeing you here, Zack!

Thanks Patrick!  Good to be back!

Hello Zack :)

Didn't know you Co-Own www.vbaexpress.com. Read it on your profile. Glad to meet you :)

@usky1: Sorry to hijack your thread.

Sid

It's a pleasure, Sid.  :)

@usky1: double apologies!

dlmille: -I am not sure if I am running your script correct.

1. Opened my worksheet.
2. Saved the attachment "check-range-input-r2.xlsm" in Visual Basic for the worksheet.  (Developer tab - Visual basic)
3. Went back to the worksheet. When I enter data in Range("D6:F6") nothing occurs to Range("B2:D2").
4. When I enter data in Range("B2:D2"),  Range("D6:F6") fills in red and is locked and  no data is allowed to be entered. This is good.
5. But when I remove the data from Range("B2:D2")   Range("D6:F6") does not remove the colors or the cell lock.

I don't mind the chatting between each other

usky1: Did you try the code that I or Zack  posted?

Sid

I'm not clear about one of your points ...

3. What do you want to happen when you enter data in D6:F6?  Are there different conditions if there is data in B2:D2 or not?

That withstanding, perhaps you could use something like this...

Option Explicit

Private Const sPWD          As String = ""
Private Const sInputRange   As String = "B2:D2"
Private Const sOutputRange  As String = "D6:F6"
Private Const iColorIndex   As Long = 3
Dim vDVal                   As Variant
Dim vEVal                   As Variant
Dim vFVal                   As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
    
    'Dimension variables
    Dim rCell As Range
    
    'Checks for single cell entry only
    If Target.Cells.Count > 1 Then Exit Sub
    
    'Checks to see if the target cell is in the specified input range
    If Intersect(Target, Me.Range(sInputRange)) Is Nothing Then
    
        'Checks to see if the target cell is in the specified output range
        If Not Intersect(Target, Me.Range(sOutputRange)) Is Nothing Then
        
            'Checks to see if there is any data in the input range
            If WorksheetFunction.CountA(Me.Range(sInputRange)) <> 0 Then
            
                'If so, put values back to what they were
                Application.EnableEvents = False
                Me.Unprotect sPWD
                Me.Range("D6").Value = vDVal
                Me.Range("E6").Value = vEVal
                Me.Range("F6").Value = vFVal
                Me.Protect sPWD
                Application.EnableEvents = True
                
            End If
        Else
            Exit Sub
        End If
        Exit Sub
    End If
    
    'Turn off events
    Application.EnableEvents = False
    
    'Checks if anything is in the input range
    Select Case WorksheetFunction.CountA(Me.Range(sInputRange))
    
    Case Is = 0
        
        'If not, clear out coloring
        Me.Range(sOutputRange).Interior.ColorIndex = 0
        Me.Range("D6").Locked = False
        Me.Range("E6").Locked = False
        Me.Range("F6").Locked = False
    
    Case Is = 1
    
        'If so, change the color of the output cells
        Me.Range(sOutputRange).Interior.ColorIndex = iColorIndex
    
    Case Else
    
        'Another value was attempted to put into the input range, put
        'everything back where it was, clearing the value and giving the user a message
        Target.ClearContents
        Me.Unprotect sPWD
        Me.Range("D6").Value = vDVal
        Me.Range("E6").Value = vEVal
        Me.Range("F6").Value = vFVal
        Me.Range("D6").Locked = True
        Me.Range("E6").Locked = True
        Me.Range("F6").Locked = True
        Me.Protect sPWD
        MsgBox "You can only enter information for one range in " & sInputRange & "!", vbExclamation, "ERROR!"
        
    End Select
    
    'Turn events back on
    Application.EnableEvents = True
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Set output range values as variant variables
    vDVal = Me.Range("D6").Value
    vEVal = Me.Range("E6").Value
    vFVal = Me.Range("F6").Value
End Sub

Select allOpen in new window

@usky1 - try again.  I just downloaded, selected cells B2-D2 and hit the delete key - the red immediately went clear and I could edit.

Try downloading the example spreadsheet and testing it as a standalone.

Let me know.

Cheers,

Dave

I'm sorry for not being clear but I am new at this and trying to learn.

I hope this clarifies what I am needing to accomplish.

I have two ranges for data entry:
Range1 = B2:D2
Range2 = D6:F6

If data is entered in any of the cells in Range1 then Range2 gets color filled and locked. If data is entered in any cell an error message appears stating that it is locked.
If data in all the cells of Range1 are cleared it unlocks and clears fill from Range2.

If data is entered in any of the cells in Range2 then Range1 gets color filled and locked. If data is entered in any cell an error message appears stating that it is locked.
If data in all the cells of Range2 are cleared it unlocks and clears fill from Range1.


SiddharthRout: Did you try the code that I or Zack  posted? I tried your code and it did nothing. I do not know who Zack is.

firefytr: I loaded your code and received this error: ' Compile error:  Method or data member not found'
Me.Range

What is the variable 'rCell' used for?

Can you upload a sample of your file?

BTW firefytr is Zack :)

Sid

Btw, you were probably getting that error message because of worksheet protection, which has been added to the above code.

Ok - updated based on your revised clarification...

Now there's an exclusive check on both ranges...

Dave
check-range-input-r3.xlsm

@usky1 - Use this ONLY if you DONT want the user to make changes OUTSIDE of Range 1 and Range 2 - the attached is modified to suit.

Its a quick patch that does Application.Undo (as opposed to lock/unlock) if change is made.  

Dave
check-range-input-r4.xlsm

firefytr: The code was probably functioning correctly but i could not figure out how to permanently remove the protection and cold not fully test it.

dlmille: Thanks for r4 I'll keep that in my library. r3 is great. Then only way i see to clear the background fill is to right click clear contents. Is there a way to also add only clear methods as space bar enter?

What do you mean, you couldn't permanently remove the protection?  What protection?  Is this your workbook we're dealing with?  Do you not know the password?  Some more info please.

Zack

@usky1 - select cells in the range and hit DELETE.  A space bar would be adding data ( a space ) to the values in the range.

So - to clear a fill of red in Range 2, you need to clear Range 1 data yes?  Just select items in range 1 and hit delete or backspace key

Does that suffice?  Otherwise, I can add space/enter but seems you have delete key and backspace keys already

Let me know,

Cheers

Dave

Sorry I forgot to close this out.  Thanks for all the continued help with helping me understand the solution.