I was wondering if someone had any suggestions to this. I want the row to highlight below row 6 when a cell is clicked on. So if I click on A7, then row 7 will highlight. If I then click on B9, row 7 will have the highlight removed and row 9 will then highlight. I did find code that does work for what I need and have customized it a little. Everything works exactly the way I need it to work, except for when Excel is saved, closed out, and reopened.
If row 9 is highlighted, and the spreadsheet is saved, closed, and reopened, row 9 will remain highlighted (even when another cell is clicked on). So now I have 2 rows highlighted. In order to fix this once the spreadsheet is opened back up is to click on a different row and then click back on row 9. Then it will be back to 1 highlighted row.
Does anyone have a solution for this? Below is the code that I am using.
Thanks for any help someone can provide,
Chris
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect
Static rr
If rr <> "" Then
With Rows(rr).Interior
.ColorIndex = xlNone
End With
End If
r = Selection.Row
rr = r
With Rows(r).Interior
.ColorIndex = 20
.Pattern = xlSolid
End With
ActiveSheet.Protect
End Sub
The following combination of code seems to be working; I'm highlighting the entire row each time.
Private lastRow As Long
Private Sub Worksheet_Activate()
lastRow = ActiveCell.Row
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If lastRow <> 0 Then
Rows(lastRow).EntireRow.Interior.ColorIndex = xlNone
If Target.Row > 6 Then
Target.Rows(1).EntireRow.Interior.ColorIndex = 20
End If
lastRow = Target.Row
Else
lastRow = Target.Row
End If
End Sub
Actually, it probably needs a bit of work. However, it might be a starting point for you.
Your static rr variable is a Variant and will not have a default value of "". So, when you re-open the file, the cursor will be in the row it was in previously, and because rr is not equal to "" it will not remove the highlight from this line. (In fact, I'm not sure how it is removing the highlight currently.)
Anyway, try:
Static rr
If IsEmpty(rr) Then
rr = ""
End If
Alternatively, give rr the data-type of Integer or Long, which will assume a default value of 0.
I wrote my own code instead of trying to work with the code I found. This works a lot better. It also allows the user to specify their own range of rows to highlight.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
ActiveSheet.Unprotect
Dim iFirstCol As Integer
Dim iLastCol As Integer
Dim iFirstRow As Integer
Dim iLastRow As Integer
Dim iColor As Integer
'''Only adjust the below numbers to fit your desired results.'''
iFirstCol = 1 'Change this number to the number of the first column that needs to be highlighted. Column A = 1.
iLastCol = 15 'Change this number to the number of the last column that needs to be highlighted. Column A = 1.
iFirstRow = 7 'Change this number to the number of the first row that needs to be highlighted.
iLastRow = 500 'Change this number to the number of the last row that needs to be highlighted.
iColor = 20 'Change this number to use a different highlight color.
'''End of changes, do not change anything else.'''
'The row highlight will only be applied if the selected range is within this if statement criteria.
If Target.Row > iFirstRow - 1 And Target.Row < iLastRow + 1 And Target.Column > iFirstCol - 1 And Target.Column < iLastCol + 1 Then
'Resets the color within the full range when cell selection changed.
ActiveSheet.Range(ActiveSheet.Cells(iFirstRow, iFirstCol), ActiveSheet.Cells(iLastRow, iLastCol)).Interior.Color = xlNone
'Applies the colors to the row.
For counter = iFirstCol To iLastCol
With ActiveSheet.Cells(Target.Row, iFirstCol).Interior
.ColorIndex = iColor
.Pattern = xlSolid
End With
iFirstCol = iFirstCol + 1
Next counter
End If
ActiveSheet.Protect
Application.EnableEvents = True
End Sub
I often highlight rows in tables on selection. While I might be over-simplifying things it seems so much easier then the code you have provided above.
Here is what I do;
I use just a tiny big of code in the Worksheet selection change for the range that should have the highlighting rows in effect, such as this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("D8:R10000")) Is Nothing Then
Range("B1").Value = ActiveCell.Row
End If
End Sub
Then I use a Conditional formatting for B1 and the range, with any type of formatting you might like for the selected row. A Conditional formatting formula for the above would be:
=$B$1=ROW()
with an Applied To range of: =$D$8:$R$10000
That's it. No other coding is required and formats can be changed simply.
What are your thoughts on this?
Related
I need help with an macro to notify me (by changing a cell background color to red), when the value (always number format) changes in any cells in the row. I want the background of cell E3 to change to red, if any of the values in cells F3:AN3 change from their current values.
The numbers in cells F3:AN3 will be entered manually or thru copy and paste of the row, and there won't be any formulas. Likewise, if any values in cells F4:AN4 are changed, I would like cell E4 to change to a red background, and so on for each of the rows in the chart. Not all rows will always have a value, so I would be looking for changes from "" to any #, or from one # to another #, or from any # to "". Ideally this would be an event macro that does not have to be run manually.
The following is the code I've started working with:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F3:AN3")) Is Nothing Then KeyCellsChanged
End Sub
Private Sub KeyCellsChanged()
Dim Cell As Object
For Each Cell In Range("E3")
Cell.Interior.ColorIndex = 3
Next Cell
End Sub
However, this macro seems to run regardless of whether the number in the cell is changed, as long as I press enter it highlight E3 as red.
Any help is much appreciated!
Here is my favorite way to detect changes in an Excel VBA app:
Create an exact copy of the range you're watching in hidden rows below the range the user sees.
Add another section below that (also hidden) with formulas subtracting the user range with the hidden range with an if statement that sets the value to 1 if the difference is anything but 0.
Use conditional formatting in the user range that changes the background color of the row if the corresponding change-detection row (or cell) is > 0.
What I like about this approach:
If a user makes a change and then reverts back to the original value, the row is "smart enough" to know that nothing has changed.
Code that runs any time a user changes something is a pain and can lead to problems. If you set up your change detection the way I'm describing, your code only fires when the sheet is initialized. The worksheet_change event is expensive, and also "may effectively turn off Excel’s Undo feature. Excel’s Undo stack is destroyed whenever an event procedure makes a change to the worksheet." (per John Walkenbach: Excel 2010 Power Programming)
You can detect if the user is navigating away from the page and warn them that their changes will be lost.
Depending on your answer to my question in the comments, this code may change. Paste this in the relevant Worksheet code area. For this to work, navigate to any other sheet and then navigate back to the original sheet.
Option Explicit
Dim PrevVal As Variant
Private Sub Worksheet_Activate()
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
PrevVal = Selection.Value
Else
PrevVal = Selection
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ExitGraceFully
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
PrevVal = Selection.Value
Else
PrevVal = Selection
End If
ExitGraceFully:
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.WorksheetFunction.CountA(Target) = 0 Then Exit Sub
Dim aCell As Range, i As Long, j As Long
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Columns("F:AN")) Is Nothing Then
If Target.Rows.Count = 1 And Target.Columns.Count >= 1 Then
Range("E" & Target.Row).Interior.ColorIndex = 3
ElseIf Target.Rows.Count > 1 And Target.Columns.Count = 1 Then
i = 1
For Each aCell In Target
If aCell.Value <> PrevVal(i, 1) Then
Range("E" & aCell.Row).Interior.ColorIndex = 3
End If
i = i + 1
Next
ElseIf Target.Rows.Count > 1 And Target.Columns.Count > 1 Then
Dim pRow As Long
i = 1: j = 1
pRow = Target.Cells(1, 1).Row
For Each aCell In Target
If aCell.Row <> pRow Then
i = i + 1: pRow = aCell.Row
j = 1
End If
If aCell.Value <> PrevVal(i, j) Then
Range("E" & aCell.Row).Interior.ColorIndex = 3
End If
j = j + 1
Next
End If
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
Resume LetsContinue
End Sub
SNAPSHOTS
It works as expected When you type a value in the cell. It also works when you copy 1 Cell and paste it in multiple cells. It doesn't work when you copy a block of cells and do a paste (I am still working on this)
NOTE: This is not extensively tested.
This is a continuation for the following question: What is the cause for Conditional Formatting to get jumbled up?
In an attempt to prevent my conditional formatting from going haywire, I decided to convert it into code in VBA. I decided to start small and start with converting one conditional formatting into VBA.
Explanation:
In column O there are a series of numbers, obtained from a different sheet. User inputs number in column F. For example if number in F9 is less than O9, the font colour will become red. If not number remains normal. The formula should start at row 9 and can continue down onwards and should be automatic.
Meaning the moment a number is keyed in column F the font colour should change instantly.
The following is the code I created so far:
Sub change_color()
With Me.Range("f9", Range("f" & Rows.Count).End(xlUp)) 'so the formula will carry onwards from f9 onwards
If f9 < o9 Then
Range(f).Font.Color = vbRed
End If
End With
End Sub
But alas it didn't work. I also tried linking it to a button and nothing happens. And I also remember to remove my old conditional formatting as well. Is there something I'm missing?
You are after something like the code below.
This code is to be ran once, it will lopp through the entire column "F" in your worksheet, and change the font of all instances.
Regular Module Code
Option Explicit
Sub change_color()
Dim LastRow As Long, i As Long
With Worksheets("Sheet1") ' modify to your sheet's name
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
For i = 1 To LastRow
If .Range("F" & i).Value < .Range("O" & i).Value Then
.Range("F" & i).Font.Color = vbRed
Else
.Range("F" & i).Font.Color = vbBlack
End If
Next i
End With
End Sub
To "catch" the modification in real-time, when someone changes a value in column "F", and then change the font according to the criteria you specified, you need add the following code to the Worksheet module, where you have your data, and add the piece of code below to Worksheet_Change event.
Code in Sheet1 module (modify to your sheet's)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 Then ' if someone changes a value in column "F"
Application.EnableEvents = False
If Target.Value < Range("O" & Target.Row).Value Then
Target.Font.Color = vbRed
Else
Target.Font.Color = vbBlack
End If
End If
Application.EnableEvents = True
End Sub
Does this work for you?
Option explicit
Sub ChangeColor()
With thisworkbook.worksheets(YOURSHEETNAME) 'Replace with sheet name as per your workbook.'
Dim LastRow as long
Lastrow = .cells(.rows.count,"F").end(xlup).row
Dim RowIndex as long
For rowindex = 9 to LastRow
If .cells(rowindex,"F").value2 < .cells(rowindex,"O").value2 then
.cells(rowindex,"F").font.color = vbred
End if
Next rowindex
End With
End Sub
I need to add checkbox for each row in few documents and I have script for that which working, and that's ok but...
If I have 10k rows then this script it's very slowly. How I can speed up it?CODE:
Sub AddCheckBoxes()
Dim chk As CheckBox
Dim myRange As Range, cel As Range
Dim ws As Worksheet
Set ws = Sheets("") 'adjust sheet to your need
Set myRange = ws.Range("A65:A75") ' adjust range to your needs
For Each cel In myRange
Set chk = ws.CheckBoxes.Add(cel.Left, cel.Top, 30, 6) 'you can adjust left, top, height, width to your needs
With chk
.Caption = "Valid"
.LinkedCell = cel.Range("B65:B75").Address
End With
Next
End Sub
Thanks!
Let's try this and see if it fits. Please paste the following code into a normal code module (by default 'Module1') of a blank workbook you create for this purpose. It is a module which doesn't exist in a new workbook. Don't use any of the existing.
Option Explicit
Enum Nws ' Worksheet rows & columns
' 20 Apr 2017
NwsFirstDataRow = 2 ' adjust as required
' Columns:
NwsMainData = 1 ' (= A) Test for used range
NwsCheck = 7 ' (= G) column for Check cell
End Enum
Enum Nck ' CheckBox
' 20 Apr 2017
NckFalse
NckTrue
NckNotSet ' any value other than True or False
End Enum
Sub SetCheckCell(Target As Range)
' 20 Apr 2017
Dim TgtVal As Nck
With Target
If Len(.Value) Then
Select Case .Value
Case True
TgtVal = NckFalse
Case False
TgtVal = NckTrue
Case Else
TgtVal = NckNotSet
End Select
Else
TgtVal = NckNotSet
End If
If TgtVal = NckNotSet Then
SetBorders Target
TgtVal = NckFalse
End If
.Value = CBool(Array(0, -1)(TgtVal))
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = Array(xlThemeColorAccent6, xlThemeColorAccent3)(TgtVal)
.TintAndShade = 0.399945066682943
.PatternTintAndShade = 0
End With
.Offset(0, -1).Select
End With
End Sub
Private Sub SetBorders(Rng As Range)
' 12 Apr 2017
Dim Brd As Long
For Brd = xlEdgeLeft To xlInsideHorizontal
SetBorder Rng, Brd
Next Brd
Rng.Borders(xlDiagonalDown).LineStyle = xlNone
Rng.Borders(xlDiagonalUp).LineStyle = xlNone
End Sub
Private Sub SetBorder(Rng As Range, _
Brd As Long)
' 12 Apr 2017
With Rng.Borders(Brd)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.349986266670736
.Weight = xlMedium
End With
End Sub
In column A, enter something - anything - in row 10 (or thereabouts). This is the last "used" row in your worksheet.
Now paste the following code in the code sheet of the worksheet on which you created a last "used" row. It must be exactly that code sheet - no other. It is a sheet which already exists. You recognise it by the tab's name in the VBE's project explorer window.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' 20 Apr 2017
Dim Rng As Range ' used range (almost)
Dim Rl As Long ' last row
Application.EnableEvents = False
With Target.Worksheet
Rl = .Cells(.Rows.Count, NwsMainData).End(xlUp).Row
Set Rng = .Range(.Cells(NwsFirstDataRow, NwsCheck), .Cells(Rl, NwsCheck))
If Not Application.Intersect(Target, Rng) Is Nothing Then
SetCheckCell .Cells(Target.Row, NwsCheck)
End If
End With
Application.EnableEvents = True
End Sub
Now you are all set to test but understand the mechanics first. At the top of the first batch of code you have Enum Nws which specifies one row and two columns. The specified row is NwsFirstDataRow with an assigned value of 2. It means that row 1 is outside the scope of this code. The code will not run when you click in row 1 (presumably a caption row). You could set NwsFirstDataRow to a value of 3, thereby creating 2 header rows which the code won't touch.
The two columns are NwsMainData and NwsCheck. NwsMainData is the column where the last row is measured. If you click below the last row the code will not run. You might find that column A doesn't suit your needs. You can set any other value, thereby specifying another column. The number you set is used for no other purpose but to find the last row. In your test, make sure the column actually has a used row.
NwsCheck is the column where you will have your "check box". You can specify any column. Try it out in a little while. The point is that the code will not run if you click any other column. Therefore, the code will run if you click in the NwsCheck column, at or below NwsFirstDataRow and at or above the last "used" row. Go ahead an click.
Since the cell is empty it will be coloured as a checkbox and filled with the word "False". Click it again and it will change colour and value will be True. It continues to toggle. The cursor moves to the left to allow you to toggle.
You could move the cursor right or up or down. You could change the colours to any colour Excel has on offer. You can change the frame from the one I have selected. You can change the words which are shown. In fact, there is very little you couldn't change - and it isn't difficult.
The question is whether the idea can be adapted to do the job you want a check box to do.
Here is a variation of the above. Instead of writing TRUE or FALSE, it actually gives you a checkbox-character which is either checked or not. The code displays a message box informing you of the status, but the idea is to execute whatever code you want to run instead, based on whether the box is checked or not.
To test this code, add this procedure to the normal code module. Some of the above code will be required for this solution. For the purpose of testing, just have the entire previous code installed. Then add this.
Function SetCheck(Cell As Range) As Boolean
' 21 Apr 2017
Dim Fun As Integer
Dim Chars() As Variant
Dim Mark As Integer ' character current displayed
Chars = Array(168, 254) ' unchecked / checked box
With Cell
If Len(.Value) Then Mark = AscW(.Value)
Fun = IIf(Mark = Int(Chars(0)), 1, 0)
With .Font
.Name = "Wingdings"
.Size = 11
End With
.Value = ChrW(Chars(Fun))
.Offset(0, 1).Select
End With
SetCheck = CBool(Fun)
End Function
Replace the existing event procedure with the one below. The difference is minute, but for quick testing, just replace all of it.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' 21 Apr 2017
Dim Rng As Range ' used range (almost)
Dim Rl As Long ' last row
Dim Chk As Boolean
Application.EnableEvents = False
With Target.Worksheet
Rl = .Cells(.Rows.Count, NwsMainData).End(xlUp).Row
Set Rng = .Range(.Cells(NwsFirstDataRow, NwsCheck), .Cells(Rl, NwsCheck))
If Not Application.Intersect(Target, Rng) Is Nothing Then
' SetCheckCell .Cells(Target.Row, NwsCheck)
Chk = SetCheck(Target.Cells(1))
MsgBox "The checkbox is now " & IIf(Chk, "", "un") & "checked"
End If
End With
Application.EnableEvents = True
End Sub
Based on a language table, column A = Language, B = number, C = coloredcell
I would like to know what is the VBA so whenever I type a number on Column B (using Workbook_SheetChange), C is colored with the Colorindex equal to the number typed.
On the other hand, and I am sure is part of the solution to the previous question, on VBA how do I write cell.Interior.ColorIndex = (a specific cell value, If B2=4 -> for the row, whole or until last column has data, cell.Interior.ColorIndex = 4) and color the whole row.
Thank you
The sheetchange function has target as an argument, that's the cell that you changed. You can use it to change the relevant cell:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
Target.Offset(0,1).Interior.ColorIndex = Target.Value
'and for the whole row
Target.EntireRow.Interior.Color = Target.Offset(0,1).Interior.Color
Endif
End Sub
The code of Nick Dewitt is OK, but it color only the column C.
If you want to color the entire row, starting from C depending of how much columns are in the row :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastcol As Integer, i As Integer
If Target.Column = 2 Then
lastcol = Cells(Target.Row, Columns.Count).End(xlToLeft).Column
For i = 3 To lastcol
Target.Offset(0, i - 2).Interior.ColorIndex = Target.Value
Next i
End If
End Sub
Right click on the sheet's name on which you want this functionality, and click on 'View Code'.
Now you need to write a VBA function that fires on any change to the worksheet. This is an inbuilt function called Worksheet_Change(Range). The range object (it's argument) is the range that had changed when this function fired.
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
Inside the function you need to check whether the changed cell was in column B. This is done by the Column property of the Target range.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
' The changed cell was in column B
End If
End Sub
Now you need to get the cell's value and put it as the row's ColorIndex.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
ColorValue = Target.Value
Target.EntireRow.Interior.ColorIndex = ColorValue
End If
End Sub
Edit: To color the cells only till the last value in the row, you need to count the number of filled cells in the row. The following code does that (see the comments to understand it)
Private Sub Worksheet_Change(ByVal Target As Range)
' Check if the edited cell is in column B
If Target.Column = 2 Then
' Get the value of the edited cell
ColorValue = Target.Value
' Get the row number of the edited cell
RowNumber = Target.Row
' Get the number of filled cells in this row
CellsCount = Application.WorksheetFunction.CountA(Range(RowNumber & ":" & RowNumber))
' Apply the color formatting till the last column in this row
Range(Cells(RowNumber, 1), Cells(RowNumber, CellsCount)).Interior.ColorIndex = ColorValue
End If
End Sub
Maybe due to my poor English some of you may misunderstood what I wanted to do. Anyways, here is the code that I wanted. After many trial and errors I made it but I doubt its the best way but it works =). If anyone know how to make the code better please tell me =).
I previous post is also below this new code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim row As Integer
For row = 1 To 1000
If Cells(row, "A").Value = "Yes" Then
Range("B" & row).Interior.ColorIndex = 4
End If
If Cells(row, "A").Value = "yes" Then
Range("B" & row).Interior.ColorIndex = 4
End If
Next row
End Sub
Previous post
I have written a VBA code in excel where I want to change a cell color everytime I write "yes". In this case I write "yes" in column E and column A should change color. I have used a for loop but it does not run as I want. I have a feeling I am thinking a bit wrong...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellNr As Long
For cellNr = 1 To 5
If Range("E" & cellNr).Value = "yes" Then
Range("A" & cellNr).Interior.ColorIndex = 5
Else
ActiveCell(0, -2).Interior.ColorIndex = 4
End If
Next cellNr
End Sub
Use conditional formatting with a formula. Starting in row 1 the formula required is
=$E1="yes"
If I understand what you are trying to do with the following line:
ActiveCell(0, -2).Interior.ColorIndex = 4
Replace it with:
ActiveCell.Offset(0, -2).Interior.ColorIndex = 4
As far as I know, the line I told you to remove will always throw an error. It doesn't make any sense syntactically. You should use the Offset function to get positions relative to the Active Cell. But also, this offset function will throw an error if your active cell is in column A or B because there are less than 2 columns to the left of the active cell.
Consider:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rOfInterest As Range
Set rOfInterest = Range("E1:E5")
If Intersect(Target, rOfInterest) Is Nothing Then Exit Sub
v = Target.Value
If v = "yes" Then
Target.Offset(0, -4).Interior.ColorIndex = 5
Else
Target.Offset(0, -4).Interior.ColorIndex = 4
End If
End Sub
and make sure the macro is in the worksheet code area.