Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.
One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.
Fill cell if empty
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
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
Who is Participating?
I think you want something more like this:
Private Sub Worksheet_SelectionChange(
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
Private Sub Worksheet_SelectionChange(
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
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
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
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
Is this what you want?
Sid
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
Sid
And to take it a bit further, managing the range input, see below - and attached.
Cheers,
dave
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
@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
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
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
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
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
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.
1. Opened my worksheet.
2. Saved the attachment "check-range-input-r2.xlsm
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'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...
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
@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
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?
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?
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
Now there's an exclusive check on both ranges...
Dave
check-range-input-r3.xlsm
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
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
@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
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?
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
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
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
Question has a verified solution.
Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.
Have a better answer? Share it in a comment.
All Courses
From novice to tech pro — start learning today.
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.
Open in new window
Zack