how can I make a Target.Adress from 1 cell to a range of cells?
If Target.Address = "$G$7" And WorksheetFunction.IsNumber(Target) Then Target = -Abs(Target)
End Sub
Changing G7 to G7:G49
I tried different examples like
If Target.Address = "(G7:G49)" And WorksheetFunction.IsNumber(Target) Then Target = -Abs(Target)
End Sub
and others... but it didn´t work.
Instead of using .Address, use Intersect.
Loop over the cells in the Intersection.
Assuming this is within a Worksheet_Change handler, disable events to prevent an infinite loop, and enable at the end.
Dim rng As Range
Set rng = Intersect(Target, Me.Range("G7:G49"))
If rng Is Nothing Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
Dim cell As Range
For Each cell In rng
If WorksheetFunction.IsNumber(cell.Value) Then
cell.Value = -Abs(cell.Value)
End If
Next
SafeExit:
Application.EnableEvents = True
Related
To protect a second section of dynamic data when rows are removed in the first section, I need to change the last section of existing code below to a dynamic range that begins at E3 and ends either at the first row where column E is blank, last row where it is => zero or use a dynamic cell reference (N2) that shows # of last row (or anything that will work). At present, I handle this new need by manually changing E10001 to the new end of the first section of data (i.e, E5006). All of my attempts (used every option I could find) at this dynamic code resulted in the date being inserted 3 columns to right of any entry I make in my test spreadsheet. Thanks in advance for any help.
Private Sub Worksheet_Change(ByVal Target As Range)
Target.Worksheet.Unprotect Password:="Midnight"
On Error Resume Next
Application.EnableEvents = True
Dim hng As Range
Set hng = Range("F3:F10001")
If Intersect(Target, hng) Is Nothing Then
Target.Offset(-1, -4).Locked = True
End If
Application.EnableEvents = True
Dim xng As Range
Set xng = Range("F3:F10001")
If Intersect(Target, xng) Is Nothing Then
Target.Offset(-1, -3).Locked = True
End If
Application.EnableEvents = True
Dim wng As Range
Set wng = Range("F3:F10001")
If Intersect(Target, wng) Is Nothing Then
Target.Offset(-1, -2).Locked = True
End If
Application.EnableEvents = True
Dim qng As Range
Set qng = Range("F3:F10001")
If Intersect(Target, qng) Is Nothing Then
Target.Offset(-1, -1).Locked = True
End If
Application.EnableEvents = True
Dim sng As Range
Set sng = Range("F3:F10001")
If Intersect(Target, sng) Is Nothing Then
Target.Offset(-1, 0).Locked = True
End If
Dim cng As Range
Set cng = Range("B3:C10001")
If Not Intersect(Target, cng) Is Nothing Then
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
End If
Dim rng As Range
Set rng = Range("E3:E10001")
If Not Intersect(Target, rng) Is Nothing Then
Target.Offset(0, 3) = Now
End If
Target.Worksheet.Protect Password:="Midnight"
End Sub
I am concluding that this is not possible. I have created a workaround using reference to calculated values in another sheet to fill the cells not needed with null data.
I need a sheet in Excel to activate if any cells in a column are selected as "Yes", but my VBA code won't stick - simple enough to do for one cell, but the whole column is throwing me. The cells are a drop down list with solely the options "Yes" or "No"
Currently trying:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$11:$H$23" Then
If ActiveWorkbook.Worksheets("Sheet1").Range("H11:H23").Value = "Yes" Then
Sheets("Sheet2").Visible = True
Else
Sheets("Sheet2").Visible = False
End If
End If
End Sub
Any tips? Thanks
An easier solution without looping would be to count the Yes using WorksheetFunction.CountIf method.
Use the following to show Sheet2 if at least one cell has the Yes.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TestRange As Range
Set TestRange = Me.Range("H11:H23")
If Not Application.Intersect(Target, TestRange) Is Nothing Then 'if target is in test range
If Application.WorksheetFunction.CountIf(TestRange, "Yes") > 0 Then
Worksheets("Sheet2").Visible = True
Else
Worksheets("Sheet2").Visible = False
End If
End If
End Sub
If all cells in the test range need to be Yes then change it to
If Application.WorksheetFunction.CountIf(TestRange, "Yes") = TestRange.Cells.Count Then
i think you could try:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range, rng As Range
Dim Inrng As Boolean
If Not Intersect(Target, Me.Range("H11:H23")) Is Nothing Then
'Set a boolean variable to false
Inrng = False
'Set a range to loop
Set rng = Me.Range("H11:H23")
'Start looping the range
For Each cell In rng
'Convert the value of a cell to Upper case to avoid case sensitive issues
If UCase(cell.Value) = "YES" Then
'Turn the variable to true if value appears in the range
Inrng = True
'Exit the loop to avoid time consuming
Exit For
End If
Next cell
If Inrng = True Then
Worksheets("Sheet2").Visible = True
Else
Worksheets("Sheet2").Visible = False
End If
End If
End Sub
I'm currently working on a calendar where some days (each separate cells) have green, blue and others red backgrounds
I would like to be able to click one cell in the given range (one day in the calendar). If that cell has a specific background color, I would like all other cells in that range that are the same color to change and the text to be bold.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Dim cell As Range
Dim Rng As Range
Set Rng = ActiveWorkbook.Sheets("Tickets").Range("N11:AW20")
For Each cell In Rng
If Target.Interior.ColorIndex = 37 Then
Target.Font.Bold = True
End If
Exit For
Next cell
End Sub
So far the text of the Target cell changes to bold but not the rest of the cells in that range.
How can I get excel to scan the rest of the range and apply the changes?
PS: Originally I would have preferred triggering the macro when hovering over the cells but I couldn't find anything to do so.
Here is the file with the calendar to give you a better idea of the whole thing.
https://drive.google.com/file/d/17tveiFHu4nlw47jqmXixIQoe6j7iOTe-/view?usp=sharing
Thanks in advance!
If you put this code into the module for the sheet with the calendar, it should activate each cell in the calendar range that has the same background color as the current selection.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngCalendar As Range
Set rngCalendar = Range("N11:AW20")
If Not Intersect(Target, rngCalendar) Is Nothing Then
SpeedUp True
rngCalendar.Font.Bold = False
Dim cel As Range
For Each cel In rngCalendar
If cel.Interior.ColorIndex = Target.Interior.ColorIndex Then
cel.Font.Bold = True
End If
Next cel
SpeedUp False
End If
End Sub
Private Function SpeedUp(ByVal toggleOn As Boolean)
With Application
.Calculation = IIf(toggleOn, xlCalculationManual, xlCalculationAutomatic)
.ScreenUpdating = Not toggleOn
.EnableEvents = Not toggleOn
End With
End Function
The problem is that your loop doesn't actually do anything to the cell it's in.
You could change it into something like this
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Dim cell As Range
Dim Rng As Range
Set Rng = ActiveWorkbook.Sheets("Tickets").Range("N11:AW20")
If target.Interior.Colorindex = 37 then
For Each cell In Rng
If cell.Interior.ColorIndex = 37 Then
cell.Font.Bold = True
End If
Next cell
End if
End Sub
I think it should help :)
Dim cell As Range
Dim Rng As Range
Dim status As Integer
Set Rng = ActiveWorkbook.Sheets("Tickets").Range("N11:AW20")
For Each cell In Rng
If Target.Interior.ColorIndex = 37 Then
Target.Font.Bold = True
status = 1
Exit For
End If
Next cell
If status = 1 Then
Rng.Interior.ColorIndex = 37
Rng.Font.Bold = True
End If
I have problem in my code, i need to change in another column - row
I tried to built macro but it's dosn't work with that.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Target, Range("A6:U1000"))
If xRg Is "YES" Then Exit Sub
Range("G" & Target.Row).Value = "CHECK"
End Sub
When in column N6:N1000 is "YES" in Column G change value to "Check" and all row A6 for example to U1000 is in color red
I can't quite understand what you're trying to achieve here, but hopefully the below will be doing roughly what you need. Try it and let me know if it doesn't behave the way you hope.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim xRg As Range, cl as Range
Set xRg = Intersect(Target, Range("A6:U1000"))
If Not xRg Is Nothing Then
For Each cl In xRg.Cells
If cl.Value = "YES" Then Range("G" & cl.Row).Value = "CHECK"
Next
End If
Application.EnableEvents = True
End Sub
I am trying to run this worksheet change event for two different columns(A) and (I)...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, B As Range, Inte As Range, r As Range
Set A = Range("A:A")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
r.Offset(0, 1).Value = Date
Next r
Application.EnableEvents = True
End Sub
This event is something i found on this forum. Its purpose is to make it so whenever data is ever entered into column "a" it auto inputs the date into the cell directly right of it. I want this to happen twice on the worksheet. I can't figure out how to change/add to it. I am trying to get it to run the logic for column A and I on my spreadsheet.
Just expand the range you set to the A variable.
Set A = Range("A:A, I:I")
Rewritten as,
Private Sub Worksheet_Change(ByVal Target As Range)
if not intersect(range("A:A, I:I"), target) is nothing then
'add error control
on error goto safe_exit
'don't do anything until you know something has to be done
dim r as range
Application.EnableEvents = False
For Each r In intersect(range("A:A, I:I"), target)
r.Offset(0, 1).Value = Date 'do you want Date or Now?
Next r
end if
safe_exit:
Application.EnableEvents = True
End Sub
edited after OP's comment
expanding on #Jeeped solution, you can avoid looping:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Range("A:A, I:I"), Target) ' define range of interest
If Not rng Is Nothing Then ' check it's not "nothing"
If WorksheetFunction.CountA(rng) = rng.Count Then 'check for all of its cells being not empty
On Error GoTo safe_exit 'add error control
Application.EnableEvents = False 'don't do anything until you know something has to be done
rng.Offset(, 1).Value = Date 'write Date next to all relevant changed cells
End If
End If
safe_exit:
Application.EnableEvents = True
End Sub