I created a Macro to change a cell to yellow when a change is made (top Macro). I now want to create a code so I can create a button to click to remove all of the yellow that was created with the top Macro.
I was able to find the bottom code which does turn manually highlighted cells from yellow back to white but not cells turned yellow from my Top Macro.
Below are the formats I used:
To create the Yellow Color when a change is made:
'Highlight cells yellow if change occurs
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Target.Interior.ColorIndex = 6
End Sub
To Remove Yellow Highlight (only works for Manual change- not the Macro)
Sub RemoveYellowFillColor()
Dim cell As Range
'Optimize Code
Application.ScreenUpdating = False
'Ensure Cell Range Is Selected
If TypeName(Selection) <> "Range" Then
MsgBox ("A2:Z1000")
Exit Sub
End If
'Loop Through Each Cell
For Each cell In Selection.Cells
If cell.Interior.Color = vbYellow Then
cell.Interior.Color = xlNone
End If
Next
End Sub
This is Rev. 1 of my answer:
As noted in comments, change from Target.Interior.ColorIndex = 6 to Target.Interior.ColorIndex = vbYellow in Workbook_SheetChange.
Then update your macro as follows:
Sub RemoveYellowFillColor()
Dim ws As Worksheet, cell As Range
'Optimize Code
Application.ScreenUpdating = False
'Loop Through Each Cell
For Each ws In Worksheets
For Each cell In ws.UsedRange.Cells
If cell.Interior.Color = vbYellow Then cell.Interior.Color = xlNone
Next cell
Next ws
Application.ScreenUpdating = True
End Sub
After running this macro, vbYellow fill will be removed from all cells on all worksheets in the workbook.
Related
I have created a simple Excel Macro which is triggered when a user clicks on a cell in a worksheet (worksheet1). Basically the macro takes the value of the cell which was clicked on and selects a target cell in a separate worksheet (worksheet2) that has the same value.
The problem is that about 20% of the time after being directed to worksheet2, the target cell is highlighted but is just out of view, i have to scroll down a couple of rows to see it. I want to be able to ensure that the target cell is always in view after the user is directed to it, but I am not sure how this can be achieved.
This is in Excel 2016.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column = 1 Then
If Target.Cells.Count = 1 Then
Application.ScreenUpdating = False
Dim c As Range
Dim ans As String
Dim Lastrow As Long
ans = ActiveCell.Value
Lastrow = Sheets("worksheet2").Cells(Rows.Count, "A").End(xlUp).Row
For Each c In Sheets("worksheet2").Range("A2:A" & Lastrow)
If c.Value = ans Then Application.Goto Reference:=Sheets("worksheet2").Range(c.Address): Exit Sub
Next
End If
End If
Exit Sub
End Sub
You can use find to find the selected item in sheet2 then just select the sheet and the found cell
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim s As Range
If Target.Column = 1 Then
Set s = Worksheets("Sheet2").Range("B:B").Find(what:=Target, lookat:=xlWhole)
If Not s Is Nothing Then
Worksheets("Sheet2").Activate
s.Select
Else: MsgBox Target.Value & " is not found in sheet 2"
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 want for a row to be highlighted when clicked and remove the highlight of that row when another one is clicked.
For this, I've found a code here to do it in a particular tab. I what to apply it to all the tabs. Therefore I've added the following code in 'ThisWorkbook':
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Static xRow
If xRow <> "" Then
With Rows(xRow).Interior
.ColorIndex = xlNone
End With
End If
pRow = Selection.Row
xRow = pRow
With Rows(pRow).Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End Sub
With this code the row gets highlighted when a value of that row is changed, but not when clicked. Is there any way to achieve to highlight when clicked for all tabs?
This works for me. It uses Worksheet_SelectionChange instead of Worksheet_SheetChange. Only current cell gets highlighted. I've added it into a sheet code window. When you paste the code directly to "ThisWorkbook" code window then it works for all Sheets.
Option Explicit
Dim PreviousCell As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not PreviousCell Is Nothing Then
Dim xRow As Variant, prow As Variant
prow = Selection.Row
xRow = prow
If Not PreviousCell Is Nothing Then
With Rows(PreviousCell.Row).Interior
.ColorIndex = xlNone
.Pattern = xlNone
End With
End If
With Rows(xRow).Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End If
Set PreviousCell = Target
End Sub
To paste the code into ThisWorkbook select the object at top above the code window > choose "Workbook" and then select the procedure > select "SheetSelectionChange".
Now copy/paste the code between
Private ..... End sub
When you click inside the Sub and it look like this ( (General) ) it's not working:
This is working:
This will not work:
Idea came from this answer:
Excel VBA: Get range of previous cell after calling LostFocus()
In Excel I would like to show value in current cell depending on its filled color ( something like IFCOLOR() ). Excel should do this automatically when I change filled color therefore it should be event.
For example:
When I fill cell in green then Excel automatically shows value 100
When I fill cell in red then automatically Excel shows value 75
and so on ...
Is it possible do this by event in Excel VBA? Or can you give me other ideas how to do it?
I used Workbook_SheetChange but this works when I change value in cell not its background color.
Regards
Jan
You can try something like this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Interior.Color = vbRed Then
ActiveCell = 75
Else
ActiveCell = " "
End If
End Sub
With a predefind range:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim rng As Range, cell As Range
Set rng = ws.Range(Cells(1, 1), Cells(100, 20))
For Each cell In rng
If cell.Interior.Color = RGB(255, 0, 0) Then
cell = 75
ElseIf cell.Interior.Color = RGB(0, 255, 0) Then
cell = 100
Else
cell = " "
End If
Next cell
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
CommandBars.OnUpdate can be used to handle most custom events. In the ThisWorkbook object:
Private WithEvents bars As CommandBars, color As Double
Private Sub bars_OnUpdate()
'If Not ActiveSheet Is Sheet1 Then Exit Sub ' optional to ignore other sheets
If ActiveCell.Interior.color = color Then Exit Sub ' optional to ignore if same color
color = Selection.Interior.color
'Debug.Print Selection.Address(0, 0), Hex(color)
If color = vbGreen Then Selection = 100 Else _
If color = vbRed Then Selection = 75
End Sub
Private Sub Workbook_Activate()
Set bars = Application.CommandBars ' to set the bars_OnUpdate event hook
End Sub
Private Sub Workbook_Deactivate()
Set bars = Nothing ' optional to unset the bars_OnUpdate event hook
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
color = Selection.Interior.color ' optional to ignore selection change events
End Sub
The above sample doesn't handle all edge cases, but can be adjust as needed.
For other custom events, the more specific CommandBarControl events should be used if possible:
CommandBarButton.Click
CommandBarComboBox.Change
CommandBarControl.OnAction
CommandBarPopup.OnAction
I have this macro which takes data from the Clipboard and paste it into an specific cell transposing some information.
Sub UpdateData()
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet2")
With ws
'~~> Using this as you are copying it from Notepad~~~~
.Activate
.Range("H1").Select
.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Worksheets("Sheet2").Range("H1" & ",H3").Copy
Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Transpose:=True
'~~Clear data content~~~~~~~~~~~~~~~~~~~~~~~~~
Range("H1:H10").ClearContents
End With
End Sub
I need this macro to update the cell B next to the line updated (C) with the NOW formula.
I have this other macro which updates the Row B whenever the Row C is updated, but they're not working together.
Sub Worksheet_Change(ByVal Target As Range)
Application.MoveAfterReturn = True
If Target.Count = 1 Then
If Not Intersect(Target, Range("C1:C1000")) Is Nothing Then
Cells(Target.Row, "B") = Now
End If
End If
End Sub
Any ideas on how should I do it?
The Target is the cell or cells that have changed and triggered the Worksheet_Change event macro. In your case, this is multiple cells so you have to deal with each individually.
Sub Worksheet_Change(ByVal Target As Range)
Application.MoveAfterReturn = True
If Not Intersect(Target, Range("C1:C1000")) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim c As Range
For Each c In Intersect(Target, Range("C1:C1000"))
Cells(c.Row, "B") = Now
Next c
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
Turn off event handling while you are changing data (adding a timerstamp) to the worksheet or you will trigger the Worksheet_Change to run on top of itself.
After determining that one or more cells in the C1:C1000 range has been altered, the For Each ... Next Statement cycles through each cell and deposits a timestamp on that row's column B.