I've found some examples of how to highlight the row of the currently selected cell. My issue is that I need to do this only in rows 3 and higher.
This is what I picked up so far:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Cells.Interior.ColorIndex = 0
With Target
.EntireRow.Interior.ColorIndex = 8
End With
Application.ScreenUpdating = True
End Sub
This works as advertised, but I am struggling with how to not lose the background color I have for header cells in rows 1 and 2. I am sure it requires an "if" of some sort, but I am not sure where I need to put it.
Also, is there anyway I can apply this to the entire workbook? I have 60 sheets in the workbook and if I can not replicate the code 60 times that would be ideal.
Any help is greatly appreciated.
The following code will do the trick:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Row <> 1 and Target.Row <> 2 Then
Application.ScreenUpdating = False
Cells.Interior.ColorIndex = 0
Range("A1:AF2").Interior.ColorIndex = 47
Target.EntireRow.Interior.ColorIndex = 8
Application.ScreenUpdating = True
End If
End Sub
you place this in ThisWorkbook instead of the specific Sheet.
the code:
If Target.Row <> 1 and Target.Row <> 2 Then
Checks if Target.Row does not equal Row 1 and 2
Related
I'm trying to introduce Checkboxes into my personal project Planning, unfortunately normal Checkboxes tend to bug out, so I found this side here and am trying to convert it into a macro to select the rows I want checks at. Specifically the last one that is NOT "Mutually Exclusive" but with data validation.
http://www.vbaexpress.com/kb/getarticle.php?kb_id=879
Unfortunately it does not let me make it into a macro like I wanted to and I spent a lot of time trying already. :(
Please Help
I tried to write a SelectionRng. Or searched for a way to write it into a Macro to select it in the Worksheet.
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("Ckboxes")) Is Nothing Then Exit Sub
'Set Target font to "marlett"
Target.Font.Name = "marlett"
'Check value of target
If Target.Value <> "a" Then
Target.Value = "a" 'Sets target Value = "a"
Target.Interior.ColorIndex = 44
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Target.ClearContents 'Sets target Value = ""
Target.Interior.ColorIndex = 0
Cancel = True
Exit Sub
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("Ckboxes")) Is Nothing Then Exit Sub
'Select a specific subset of the range "Ckboxes"
Select Case Target.Address
Case Else
'Populate the cell to the right of Target with its status
If Target.Value = "a" Then
Target.Offset(0, 6) = "Checked"
Else:
Target.Offset(0, 6).Value = "Not Checked"
End If
End Select
End Sub
Have had some great help from this forum on editing my codes. I need to update it just slightly, but can't seem to figure out the right solution. Essentially, my code allows for cell clearing and color in adjacent data validation dropdowns. I have the primary dropdown in column F, secondary dropdown in column G, and final dropdown in column H. My code works as such: if the primary dropdown value in column F changes, clear and color adjacent cells in column G and H. If only secondary dropdown value in column G changes, clear and color adjacent cells in column H.
What I need is if there is a change in primary dropdown in column F, not to clear contents, but only color the cell, while still clearing and coloring adjacent cells in column G and H, or clearing and coloring adjacent cells in column H if change in secondary dropdown in column G.
I tried adjusting the (For i = Target.Column + 1 To 8) to (For i = Target.Column + 0 to 8) and it does work with coloring the primary dropdown, but then it clears it. And I can't make a selection because it is clearing it consistently. Thus, I cannot make any adjacent dropdown selections.
Here is the code I have so far:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
If Target.CountLarge <> 1 Then Exit Sub 'screen out multi-cell changes
If Target.Column > 7 Then Exit Sub 'col 1/2
If Not CellHasValidation(Target) Then Exit Sub '...with validation
On Error GoTo haveError 'ensure events are not left off
Application.EnableEvents = False
'loop to max column to be cleared
For i = Target.Column + 1 To 8
With Target.EntireRow.Cells(i)
.Interior.ColorIndex = 44
.Value = ""
End With
Next i
Application.EnableEvents = True
haveError:
MsgBox Err.Description
Application.EnableEvents = True
End Sub
'check if a cell has validation
Function CellHasValidation(cell As Range) As Boolean
Dim vt
On Error Resume Next 'ignore if error (no validation)
vt = cell.Validation.Type
On Error GoTo 0 'stop ignoring errors
CellHasValidation = Not IsEmpty(vt)
End Function
So after a bit of troubleshooting, I was able to embed if statements into the code in order to test for the target column before running the entire row change.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
If Target.CountLarge <> 1 Then Exit Sub 'screen out multi-cell changes
If Target.Column > 7 Then Exit Sub 'col 1/2
If Not CellHasValidation(Target) Then Exit Sub '...with validation
On Error GoTo haveError 'ensure events are not left off
Application.EnableEvents = False
'loop to max column to be cleared
If Target.Column = 6 Then
ActiveCell.Interior.ColorIndex = 44
End If
If Target.Column = 7 Then
ActiveCell.Interior.ColorIndex = 44
End If
For i = Target.Column + 1 To 8
With Target.EntireRow.Cells(i)
.Interior.ColorIndex = 44
.Value = ""
End With
Next i
Application.EnableEvents = True
Exit Sub
haveError:
MsgBox Err.Description
Application.EnableEvents = True
End Sub
'check if a cell has validation
Function CellHasValidation(cell As Range) As Boolean
Dim vt
On Error Resume Next 'ignore if error (no validation)
vt = cell.Validation.Type
On Error GoTo 0 'stop ignoring errors
CellHasValidation = Not IsEmpty(vt)
End Function
so i have a sheet and whenever something in the range of A10:A23 is changed/updated, it is supposed to put a timestamp in the according column in Row B, however it isnt working and i have no idea why.
I already set the sheets code to "Worksheet" and "change"
Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = A And Target.Column >= 10 And Target.Column <= 23 Then
Cells(Target.Column, B) = Now()
End If
End Sub
Thanks in advance!
Assuming you will only change one cell at a time (which is not always true):
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A10:A23")) Is Nothing Then
If Target.Count = 1 Then
Application.EnableEvents = False
Target.Offset(0, 1) = Now()
Application.EnableEvents = True
End If
End If
End Sub
I am trying to build a VBA code which would do the following task
Whenever there is an entry in the Name column the VBA will automatically generate id's for each row.
id Name
NL-1 abc
NL-2 fljf
NL-3 fdgfd
NL-4 dsfsd
NL-5 dsfdsf
I am using the following VBA script and it works fine when it is just numbers.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim maxNumber, x As Long
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Rows.Count > 1 Then Exit Sub
If Cells(Target.Row, 1) > 0 Then Exit Sub
maxNumber = Application.WorksheetFunction.Max(Range("A:A"))
Target.Offset(0, -1) = maxNumber + 1
End If
End Sub
The output of above code
id Name
1 abc
2 ada
3 skfn
But when I try to introduce "NL=" in the code thats where I am facing problems.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim maxNumber, x As Long
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Rows.Count > 1 Then Exit Sub
If Cells(Target.Row, 1) > 0 Then Exit Sub
maxNumber = Application.WorksheetFunction.Max(Range("A:A"))
Target.Offset(0, -1) = "NL-" & maxNumber + 1
End If
End Sub
The output of this code is
id Name
NL-1 abc
NL-1 ada
NL-1 skfn
Please let me know if someone can figure this out. This would be a huge help.
Thanks.
Keep getting error mentioned in the title on the "insert" line of code. Both the cut and insert lines of code appear to be the same size. I've been staring at this thing for hours. I can't figure out where I'm messing up.
Sub Worksheet_Change(ByVal Target As Range)
'convert communites by status
If Not Intersect(Target, Range("H1:H1000")) Is Nothing Then
If Cells(Target.Row, 8) = "Takedown" Then
Range(Target.EntireRow, Target.Offset(13, 0).EntireRow).Cut
Sheets("AIKEN.AUGUSTA-TAKEDOWN").Range(Range("A12").EntireRow,
Range("A25").EntireRow).Insert
Range("B12:B25").Interior.ColorIndex = 3
Range("C13").Select
End If
End If
End Sub
expected result: row range is cut from one part of the sheet and inserted in a different area of the sheet.
Actual result: error on insert line of code.
Try this:
Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Target.CountLarge > 1 Then Exit Sub
Set rng = Application.Intersect(Target, Me.Range("H26:H1000"))
If Not rng Is Nothing Then
If Cells(rng.Row, 8) = "Takedown" Then
Application.EnableEvents = False '<< don't re-trigger on Cut
Range(rng.EntireRow, rng.Offset(13, 0).EntireRow).Cut
Me.Range("A12:A25").EntireRow.Insert
Application.EnableEvents = True '<< re-enable events
Me.Range("B12:B25").Interior.ColorIndex = 3
Me.Range("C13").Select
End If
End If
End Sub