I'm trying to put a macro where I select Yes in a row, the next cells are grayed out. So I have got couple of yes columns, but for the life of me can't figure/fix out the error
Error
Runtime Error 1004
Application-defined or object-defied error
Code
Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveCell.Column = 5 Then
Set r = Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 7))
If Target.Value = "Yes" Or Target.Value = "YES" Then
r.Interior.Color = RGB(192, 192, 192)
Else
r.Interior.Color = xlNone
End If
End If
If ActiveCell.Column = 7 Then
Set s = Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 3))
If Target.Value = "Yes" Or Target.Value = "YES" Then
s.Interior.Color = RGB(192, 192, 192)
Else
s.Interior.Color = xlNone
End If
End If
End Sub
Changing ActiveCell to Target is a good start. You should also compensate for more than a single target cell in case a block of values is pasted into a range overlapping columns E and/or G.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Union(Columns(5), Columns(7))) Is Nothing Then
On Error GoTo Fìn
Application.EnableEvents = False
Dim o As Range, t As Range
For Each t In Intersect(Target, Union(Columns(5), Columns(7)))
Select Case t.Column
Case 5
Set o = t.Offset(0, 1).Resize(1, 7)
Case 7
Set o = t.Offset(0, 1).Resize(1, 3)
End Select
If LCase(t.Value) = "yes" Then
o.Interior.Color = RGB(192, 192, 192)
Else
o.Interior.Pattern = xlNone
End If
Next t
End If
Fìn:
Set o = Nothing
Application.EnableEvents = True
End Sub
I've only set the range of the cells to receive the fill color first. Note that there does seem to be a crossover logic issue where if E5 receives a Yes and G5 receives a No then only K5:L5 will be grey. I made the comparison to yes non-case-sensitive.
Errors are covered by a safe exit.
ActiveCell is not the cell that changed. Target is. You need to replace all of the references to ActiveCell to Target and adjust the offsets accordingly.
Found the issue though, it was using conditional highlighting so that's what was conflicting with the macro
Related
I am trying to make my spreadsheet autofill the corresponding cell when one of the related cells have been changed.
I have previous just defined the target as:
If Target.Address = "$A$5" then
and had no issues.
However, now my target can be one of many cells and I read that the intersect method should be able to work for this but when I input my code as:
If Intersect(Target, Range(Cells(12,2), Cells(12,j-1))) Is Nothing Then
(I am trying to change the cells below the target, with the target being any of the cells between 12B and 12(j-1) with j being previously defined)
I get the following error:
"Run-time error '1004': Application-defined or object-defined error"
But from I can tell, my code is exactly the same as all the examples around.
My full code is (although there may be an unrelated error with my vlookup as well)
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range(Cells(12, 2), Cells(12, j-1))) Is Nothing Then
If IsEmpty(Target) Then
Target.Interior.ColorIndex = 19
Else:
If Range("$A$13").Value = "" Then
Range("$A$13").Value = "Care Type"
Range("$A$13").Font.Bold = True
End If
Target.Interior.ColorIndex = xlNone
Target.Offset(1, 0).Interior.ColorIndex = 19
Target.Offset(2, 0).Value = Application.WorksheetFunction. _
VLookup(Target, Sheets("Sheet2").Range("$E$3:$F$6"), 2)
Target.Offset(2, 0).Font.Bold = True
i = 2
Do Until IsEmpty(Cells(11, i))
If Cells(11, i).Value <= ChildCount Then
Cells(12, i).Interior.ColorIndex = 19
End If
i = i + 1
Loop
End If
End If
End Sub
After using Intersect to determine that at least one cell in your range has been changed, you need to iterate through the matching cells.
Turn off event handling or the Worksheet_Change will run on top of itself when you start changing values on the worksheet.
Private Sub Worksheet_Change(ByVal Target As Range)
If not Intersect(Target, Range(Cells(12, 2), Cells(12, 11))) Is Nothing Then
on error goto safe_exit
application.enableevents = false
dim t as range
for each t in Intersect(Target, Range(Cells(12, 2), Cells(12, 11)))
If IsEmpty(t) Then
t.Interior.ColorIndex = 19
Else
If Range("$A$13").Value = "" Then
Range("$A$13").Value = "Care Type"
Range("$A$13").Font.Bold = True
End If
t.Interior.ColorIndex = xlNone
t.Offset(1, 0).Interior.ColorIndex = 19
t.Offset(2, 0).Value = Application.WorksheetFunction. _
VLookup(Target, Sheets("Sheet2").Range("$E$3:$F$6"), 2)
t.Offset(2, 0).Font.Bold = True
i = 2
'I really don't know what the following code is intended to do
'probably better as a conditional formatting rule
Do Until IsEmpty(Cells(11, i))
If Cells(11, i).Value <= ChildCount Then
Cells(12, i).Interior.ColorIndex = 19
End If
i = i + 1
Loop
End If
next t
End If
safe_exit:
application.enableevents = true
End Sub
I am a novice coder recently getting away from web-based coding and was having an error with my script. I already can tell that this is poorly scripted and was wondering if I could receive any help.
This script is simply supposed to set the equivalent offset cell to the current time and date after any of the cells in that range is changed. I believe my poor scripting is either causing a loop or miss-calculating information as excel crashes after the event fires.
Any help would be greatly appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E5:E100")) Is Nothing Then
Target.Offset(0, 3) = Now()
Target.Offset(0, -1) = Target.Offset(0, -1).Value + 1
Else
If Intersect(Target, Range("F5:F100")) Is Nothing Then Exit Sub
Target.Offset(0, 2) = Now()
Target.Offset(0, -1) = Target.Offset(0, -1).Value + 1
End If
End Sub
Using If Intersect(Target, Range("E5:E100")) Is Nothing as the criteria is checking that the target doesn't intersect your range. I'm going to assume, based on the Offsets you use that you're only actually interested in columns E and F.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False 'prevent event re-firing based on changes made by the event
If Not (Intersect(Target, Range("E5:F100")) Is Nothing) Then
Target.Offset(0, (7 - Target.Column)) = Now()
Target.Offset(0, -(Target.Column - 4)) = Target.Offset(0, -(Target.Column - 4)).Value + 1
End If
Application.EnableEvents = True 'allows event to fire again
End Sub
So to clarify, the above looks for changes in columns E or F (rows 5 to 100) and if there is one writes the date stamp to the same row in column G, and the counter to column D.
You need to temprorarily stop the events from happening as you are changing the value on the sheet which then fires the event again and it continues to loop till excel crashes.
Put
Application.EnableEvents = False
At the beginning and make sure to add
Application.EnableEvents = True
At the end to turn them back on.
So:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E5:E100")) Is Nothing Then
Application.EnableEvents = False
Target.Offset(0, 3) = Now()
Target.Offset(0, -1) = Target.Offset(0, -1).Value + 1
Application.EnableEvents = True
Else
If Not Intersect(Target, Range("F5:F100")) Is Nothing Then
Application.EnableEvents = False
Target.Offset(0, 2) = Now()
Target.Offset(0, -1) = Target.Offset(0, -1).Value + 1
Application.EnableEvents = True
End If
End Sub
I am attempting to allow a user to enter a value as a either a percentage, or as a number of hours - with the unused option being auto-populated with a macro using what has been input.
Using the below example if a user were to key in 25 hours, the macro would then add a formula to B2 (shown in B3 for reference) to calculate 25% (of the total shown in C2), this would also work if the user added the percentage to cell B2, it would then populate A2 with the number of hours (again using the total shown in C2).
I have got the macro working to achieve this:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
If Cell.Address = "$A$2" Then
Application.EnableEvents = False
Range("B2").Formula = "=(A2/C2)*100"
Application.EnableEvents = True
End If
Next Cell
For Each Cell In Target
If Cell.Address = "$B$2" Then
Application.EnableEvents = False
Range("A2").Formula = "=(B2*C2)/100"
Application.EnableEvents = True
End If
Next Cell
End Sub
What I am now trying to establish is there a more efficient way of
re-using this on different rows?
The columns would remain the same but ideally it would work on rows 2 through to 100. At the movement the only option I can think of is to copy the macro multiple times and reference the cells used individuall.
Any pointers or suggestions very much appreciated.
To do all the rows Between 2 and 100 then use this:
Use Intersect to detemine if the cell that changed in in a specific range.
Use R1C1 notation on the formula to ensure that the same row is being evaluated.
The code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A100")) Is Nothing Then
Application.EnableEvents = False
Target.Offset(, 1).FormulaR1C1 = "=(RC[-1]/RC[1])*100"
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("B2:B100")) Is Nothing Then
Application.EnableEvents = False
Target.Offset(, -1).FormulaR1C1 = "=(RC[1]*RC[2])/100"
Application.EnableEvents = True
End If
End Sub
Just change your tests to look at the column property instead and use relative references - like so:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
If Cell.Column = 1 And (Cell.Row >= 2 And Cell.Row <= 100) Then
Application.EnableEvents = False
Cell.Offset(0, 1).FormulaR1C1 = "=(RC[-1]/RC[1])*100"
Application.EnableEvents = True
End If
Next Cell
For Each Cell In Target
If Cell.Column = 2 (Cell.Row >= 2 And Cell.Row <= 100) Then
Application.EnableEvents = False
Cell.Offset(0, -1).FormulaR1C1 = "=(RC[1]*RC[2])/100"
Application.EnableEvents = True
End If
Next Cell
End Sub
The code below makes sure that only one of the cells in the range("D16:E25") can contain any value, when any value/string is entered in one of the other cell's within this range, the code deletes all the others. (This part works fine, thanks to "Macro Man")
Now I'd like the code to copy(and paste to "B5") a value from a certain cell in Column B, this needs to be the the cell in the same row as the value in the range("D16:E16").
Tried the folowing code you can find below... but it didn't work.
Does annyone knows a sollution for this?
I'd prefer the workbook (cell "B5") to auto update, so without having to run macro's or press buttons.
If Not Intersect(Target, Range("D16:E25")) Is Nothing Then
If Target.Cells.Count > 1 Then
MsgBox "Please edit one cell at a time!"
Else
Application.EnableEvents = False
newVal = Target.Value
Range("D16:E25").ClearContents
Target.Value = newVal
a = ActiveCell
Application.EnableEvents = True
End If
End If
If a.Column = 4 Then
Range("B5") = Range(a).Offset(0, -2).Value
Else: Range("B5") = Range(a).Offset(0, -3).Value
End If
End Sub
Setting up a as a Range object may be a little overkill since you already have the row by looking at the single cell target.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D16:E25")) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
If Intersect(Target, Range("D16:E25")).Cells.Count > 1 Then
Application.Undo
MsgBox "Please edit one cell at a time!"
Else
Dim newVal As Variant
newVal = Target.Value
Range("D16:E25").ClearContents
Target.Value = newVal
Cells(5, 2) = Cells(Target.Row, 2).Value
End If
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
3 Issues here:
Firstly if a is set as a Range then the correct way to do it would be
Set a = ActiveCell
Secondly, if a is set as a Range, the correct way to call it in the second if function would be
If a.Column = 4 Then
Range("B5") = a.Offset(0, -2).Value
Else: Range("B5") = a.Offset(0, -3).Value
End If
instead of
If a.Column = 4 Then
Range("B5") = Range(a).Offset(0, -2).Value
Else: Range("B5") = Range(a).Offset(0, -3).Value
End If
and thirdly the above if function should be placed between
Set a = ActiveCell
and
Application.EnableEvents = True
then your program will be run as intended when the intersect is true.
Excel VBA 2010
This is a quick function that when the user click on a cell (A Column), it creates a checkmark. I also want the function to make the text in adjacent cell (B column) change color.
I'm currently getting this error: Run-time error '9': Subscript out of Range
It highlights this line:
Target.Offset(0,1).Interior.ColorIndex = RGB(77, 191, 46)
Here's the full code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A3:A20")) Is Nothing Then
Target.Font.Name = "Marlett"
If Target = vbNullString Then
Target = "a"
Target.Offset(0, 1).Interior.ColorIndex = RGB(77, 191, 46)
Else
Target = vbNullString
Target.Offset(0, 1).Interior.ColorIndex = RGB(0, 0, 0)
End If
End If
End Sub
Any Advice??
Change .Interior.ColorIndex to .Font.Color and that should do :)