Solved

Fill cell if empty

Posted on 2011-03-05
26
438 Views
Last Modified: 2012-05-11
I am new to Excel coding and was trying to figure a way to fill in cells.

Using Excel 2007

Example: I have 2 ranges set.
Range 1 = cells B2, C2 and D2
Range 2 = cells D6, E6 and F6

All cells are blank.
If I enter anything in either of the cells in Range 1 then all the cells in Range 2 are filled in and as long as anything stays in Range 1 nothing can be entered in Range 2.
I then need an error message to pop up stating that you can only enter information for one range.

I tried this as a start to fill in if not blank and that is why I am asking for help.

Private Sub Worksheet_Blank(ByVal Target As Range)
Dim r As Range
If Target.Address <> "$B$2:$D$2" Then Exit Sub
Set r = Range("D6:F6")

If Target <> " " Then
With r
.Interior.ColorIndex = 3
End With
End If

End Sub




0
Comment
Question by:usky1
  • 9
  • 7
  • 5
  • +2
26 Comments
 
LVL 41

Expert Comment

by:dlmille
ID: 35044802
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
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35044806
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

Open in new window

0
 
LVL 14

Expert Comment

by:Zack Barresse
ID: 35044826
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

Open in new window

0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35044837
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

Open in new window


Sid
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35044845
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

Open in new window

check-range-input-r1.xlsm
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35044874
@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

Open in new window

check-range-input-r2.xlsm
0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 35044978
Great seeing you here, Zack!
0
 
LVL 14

Expert Comment

by:Zack Barresse
ID: 35044983
Thanks Patrick!  Good to be back!
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35044990
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
0
 
LVL 14

Expert Comment

by:Zack Barresse
ID: 35044994
It's a pleasure, Sid.  :)

@usky1: double apologies!
0
 

Author Comment

by:usky1
ID: 35046282
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.
0
 

Author Comment

by:usky1
ID: 35046285
I don't mind the chatting between each other
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35046740
usky1: Did you try the code that I or Zack  posted?

Sid
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 14

Expert Comment

by:Zack Barresse
ID: 35046770
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

Open in new window

0
 
LVL 41

Expert Comment

by:dlmille
ID: 35047783
@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
0
 

Author Comment

by:usky1
ID: 35048555
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?


0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35048676
Can you upload a sample of your file?

BTW firefytr is Zack :)

Sid
0
 
LVL 14

Accepted Solution

by:
Zack Barresse earned 250 total points
ID: 35048776
Apologies for the confusion.  I am Zack.  My online moniker here is firefytr.  Sorry about that.

This is a worksheet event, which means it must be housed in the worksheet code module of the worksheet you're working on.  To do so, right click the worksheet name tab and select View Code.  Paste the code into the module.  You can only have one Option Explicit statement at the top of each module.  You can only have one Worksheet_Change event per worksheet code module.

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
    
    'Unprotect and disable events
    Application.EnableEvents = False
    Me.Unprotect sPWD
                
    '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
                Me.Range("D6").Value = vDVal
                Me.Range("E6").Value = vEVal
                Me.Range("F6").Value = vFVal
            
            Else
                
                'Unlock the output range
                Me.Range(sOutputRange).Locked = False
                    
                If WorksheetFunction.CountA(Me.Range(sOutputRange)) <> 0 Then
                
                    'Make input range inaccessible
                    Me.Range(sInputRange).Interior.ColorIndex = iColorIndex
                    Me.Range(sInputRange).Locked = True
                
                Else
                
                    'Reset input range
                    Me.Range(sInputRange).Interior.ColorIndex = 0
                    Me.Range(sInputRange).Locked = False
                
                End If
                
            End If
        Else
            GoTo ExitNow
        End If
        GoTo ExitNow
    End If
    GoTo ContinueNow
    
ExitNow:

    'Reset sheet protection and events, then exit
    Me.Protect sPWD
    Application.EnableEvents = True
    Exit Sub
                
ContinueNow:
                
    'Turn off events
    Application.EnableEvents = False
    Me.Unprotect sPWD
    
    '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.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
        MsgBox "You can only enter information for one range in " & sInputRange & "!", vbExclamation, "ERROR!"
        
    End Select
    
    'Turn events back on
    Application.EnableEvents = True
    Me.Protect sPWD
    
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

Open in new window


Zack
0
 
LVL 14

Expert Comment

by:Zack Barresse
ID: 35048793
Btw, you were probably getting that error message because of worksheet protection, which has been added to the above code.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35049053
Ok - updated based on your revised clarification...

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

Dave
check-range-input-r3.xlsm
0
 
LVL 41

Assisted Solution

by:dlmille
dlmille earned 250 total points
ID: 35049113
In the above post, I interrogeted to check whether there was a change in range 1 OR range 2.  Then, if changes were being made in Range 1, if range 2 was empty, range 2 got colored Red, otherwise an error message popped up.  Same thing if changes were being made in Range 2 instead of Range 1 - if Range 1 is empty, then Range 1 colored Red, otherwise an error message popped up.  In either case, the VALID range was colored clear, while the INVALID RANGE (when the alternate range had data) was colored RED.

This allows changes anywhere else in the worksheet, except these two ranges - I assume that's your requirement, yes?  Otherwise, I can do a simple modification.

Dave
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35049172
@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
0
 

Author Comment

by:usky1
ID: 35050736
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?

0
 
LVL 14

Expert Comment

by:Zack Barresse
ID: 35051675
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
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35052337
@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
0
 

Author Closing Comment

by:usky1
ID: 35107499
Sorry I forgot to close this out.  Thanks for all the continued help with helping me understand the solution.
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now