The below code is for conditional formatting of selected rows within a table.
I tried to replace the range related to the table by the table name reference in order to allow the change of the range automatically when new data is added.
But when I tried that, it shows the following message:
The row in the code highlighted is the one with red as below.
Any help will be appreciated.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("Table1")
[COLOR="#FF0000"]If Not Intersect(Target, tbl.DataBodyRange.Select) Is Nothing Then [/COLOR]
Dim Cell As Range
Range("A4").NumberFormat = "#"
If Target.Count > 1 And Target.Count < 50 Then
StopCode
For Each Cell In Selection
Range("A4").Value = Range("A4").Value & "(" & Cell.Row - 21 & ")"
Next Cell
ResetCode
Else
Range("A4").Value = "(" & Target.Row - 21 & ")"
End If
Else
Range("A4").ClearContents
End If
End Sub
Try the following instead, without the use of Select...
If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
Related
I'm trying to create a function in VBA to add a text to an existing cell.
,
I want to add "Brand" to cells in the first column. I want to use this function in any cell where I enter the formula.
I'm very new to VBA. I tried searching the internet but couldn't find a simple solution for my level. Could anyone please help me with this?
Thank you
Add a new module in the Visual Basic Editor (VBE).
Add this code to the module:
Option Explicit
Public Sub Add_Brand()
Dim Cell As Range
For Each Cell In Selection
Cell = "Brand " & Cell
Next Cell
End Sub
Select a range of cells, go to View > Macros on the toolbar and run the Add_Brand macro.
Edit: I should add that if the selected range of cells contain a formula then this will overwrite the formula with the new value.
Edit 2: If you did have formula (not an array formula) I guess you could use this code....
Public Sub Add_Brand()
Dim Cell As Range
For Each Cell In Selection
If Cell.HasFormula Then
Cell.Formula2 = "=""Brand "" & " & Mid(Cell.Formula2, 2, Len(Cell.Formula2))
Else
Cell = "Brand " & Cell
End If
Next Cell
End Sub
A Worksheet Change: Add a Prefix
The following code needs to be copied to the sheet module of the worksheet where it is meant to be applied e.g. Sheet1 (not in a standard module e.g. Module1 nor in the ThisWorkbook module).
It runs automatically: whatever you attempt to write to A2:A1048576 gets the "Brand " prefix.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const FIRST_CELL As String = "A2"
Const PREFIX As String = "Brand "
On Error GoTo ClearError
Dim trg As Range
With Me.Range(FIRST_CELL)
Set trg = .Resize(Me.Rows.Count - .Row + 1)
End With
Dim irg As Range: Set irg = Intersect(trg, Target)
If irg Is Nothing Then Exit Sub
Dim pLen As Long: pLen = Len(PREFIX)
Dim iCell As Range, iString As String
Application.EnableEvents = False
For Each iCell In irg.Cells
iString = CStr(iCell.Value)
If Len(iString) > 0 Then
'If InStr(1, iString, PREFIX, vbTextCompare) <> 1 Then
iCell.Value = PREFIX & iString
'End If
End If
Next iCell
ProcExit:
On Error Resume Next
If Not Application.EnableEvents Then Application.EnableEvents = True
On Error GoTo 0
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "':" & vbLf & Err.Description
Resume ProcExit
End Sub
Select the first cell you want to change before running the code.
Sub insertBrand()
Do While ActiveCell.Value <> ""
ActiveCell.Value = "Brand " & ActiveCell.Value
Cells(ActiveCell.Row + 1, ActiveCell.Column).Activate
Loop
End Sub
To Retrieve target cells Column Header and Row Header(In this case, it is the 1st value of the row) I am using below code in VBA:-
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim ColumnHeader As String
Dim RowHeader As String
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A1:G106")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
MsgBox "Cell " & Target.Address & " has changed."
ColumnHeader = Cells(1, Target.Column)
RowHeader = Cells(1, Target.Row)
MsgBox ColumnHeader
MsgBox RowHeader
End If
End Sub
I am getting value for ColumnHeader only. Am I missing something while retrieving RowHeader Value?
Example:
If I change $C3, it should get values 'LINE2' and '222' respectively
Try this..
replace RowHeader = Cells(1, Target.Row) with RowHeader = Cells(Target.Row,1) ... Cells are referred to as Cells(RowNumber,ColumnsNumber)
I have a ByVal code to clear the contents of a specific range inside a table, it works. But I need to add a condition for the instructions execute if the RANGE VALUE (content) change, not if I only place the cursor on it.
Also, someone knows how to reference a table column in VBA? Now I'm using an estimated range "C1:C999" but I'll like to use his name "A_[OPERATION]".
This is the code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Range("C1:C999"), Range(Target.Address)) Is Nothing Then
Range(Selection, Selection.End(xlToRight)).ClearContents
End If
End Sub
You could use the change event instead.
Here's a link to the documentation:
https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.change
Alternatively, you could save the value of your target cell in a variable and check if the value changed before executing your clear contents.
For your second question, you should probably ask about it in a separate post.
A Worksheet Change
Adjust the table name (tName) and the header (column) name (hName).
I have adjusted it to clear contents in the cells after the column.
If you really need to clear the contents of the column too, then replace cel.Offset(, 1) with cel.
In a table, the current setup will automatically clear the contents of all the cells to the right of the specified column, if a value in the column is manually or via VBA changed. This will not work if the column contains formulas. Non-contiguous deletions are also supported.
The code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const ProcName As String = "Worksheet_Change"
On Error GoTo clearError
Const tName As String = "A_"
Const hName As String = "OPERATION"
Dim rng As Range
Set rng = Range(tName & "[" & hName & "]")
Set rng = Intersect(rng, Target)
If rng Is Nothing Then GoTo ProcExit
Application.EnableEvents = False
With ListObjects(tName).HeaderRowRange
Dim LastColumn As Long
LastColumn = .Columns(.Columns.Count).Column
End With
Dim cel As Range
For Each rng In rng.Areas
For Each cel In rng.Cells
With cel.Offset(, 1)
.Resize(, LastColumn - .Column + 1).ClearContents
End With
Next cel
Next rng
CleanExit:
Application.EnableEvents = True
GoTo ProcExit
clearError:
Debug.Print "'" & ProcName & "': " & vbLf _
& " " & "Run-time error '" & Err.Number & "':" & vbLf _
& " " & Err.Description
On Error GoTo 0
GoTo CleanExit
ProcExit:
End Sub
A change in cell value is captured by the Worksheet_Change event-handle.
However, this handle will trigger even if it is a false change. For example, if the cell value before the change is "A", and user just entered "A" again in the cell, the Change event procedure will be triggered anyhow.
To avoid this, we can use Worksheet_Change and Worksheet_SelectionChange together.
Using Worksheet_SelectionChange, we record the old value somewhere, say a Name. Then using Worksheet_Change, we can compare what the user has entered against the Name to see if a true change is made.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Nm As Name: Set Nm = ActiveWorkbook.Names("OldValue")
If Target.Count = 1 Then
'This only record one old cell value.
'To record multiple cells old value, use a hidden Worksheet to do so instead of a Name.
Nm.Comment = Target.Value2
else
Nm.Comment = Target.Value2(1, 1)
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nm As Name: Set Nm = ActiveWorkbook.Names("OldValue")
If Target.Value2 <> Nm.Comment Then
Debug.Print "True change"
Else
Debug.Print "False change"
End If
End Sub
You can access a table's methods and properties through the listobject object. Below is an example how to do so.
Sub Example()
Dim lo As ListObject
Dim lc As ListColumn
Set lo = Range("Table1").ListObject
Set lc = lo.ListColumns("Column2")
End Sub
That said, for your case, it would be Range("A_").ListObject.ListColumns("OPERATION").DataBodyRange.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("F2:F220")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Range("G2:G220").Value < 0 Then
MsgBox "Cell " & Target.Address & " has changed."
End If
End If
End Sub
There's a formula in column G that calculates the value from numbers in column F. I wanted a popup when a result in G has a negative value. The type mismatch is on the line If Range("G2:G220") ... The column is formatted as Number, but it shows as Variant/Variant. I assume this is because the cell contents are actually a formula?
Is there a way round this without introducing 'helper' columns?
This is only my second bit of VBA so I'm happy to hear if you spot any other errors!
Restrict the Number of Results
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const KeyAddress As String = "F2:F220"
Const CheckColumn As Variant = "G" ' e.g. "A" or 1
Const MaxResults As Long = 1
' Define 'KeyCells'.
Dim KeyCells As Range: Set KeyCells = Range(KeyAddress)
' Define the range of cells that have changed and are part of 'KeyCells'.
Dim rng As Range: Set rng = Application.Intersect(Target, KeyCells)
' Check if there are any cells that have changed and are part of 'KeyCells'.
If rng Is Nothing Then Exit Sub
' Check if there is more than 'MaxResults' cells that have changed and
' are part of 'KeyCells'.
If rng.Cells.Count > MaxResults Then GoSub checkMoreCells
' Calculate the offset between 'Key' and 'Check' columns.
Dim ColOff As Long: ColOff = Columns(CheckColumn).Column - KeyCells.Column
Dim cel As Range
For Each cel In rng.Cells
' Check if the value in 'Check' column is negative.
If cel.Offset(, ColOff).Value < 0 Then
MsgBox "Cell '" & cel.Address(False, False) & "' has changed " _
& "to '" & cel.Value & "'."
End If
Next cel
Exit Sub
checkMoreCells:
Dim msg As Variant
msg = MsgBox("There could be '" & rng.Cells.Count & "' results. " _
& "Are you sure you want to continue?", _
vbYesNo + vbCritical, _
"More Than One Cell")
If msg = vbYes Then Return
Exit Sub
End Sub
Something like this should work:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Application.Intersect(Range("F2:F220"), Target) 'Target is already a Range...
'any changed cells in F2:F220 ?
If Not rng Is Nothing Then
'loop over the changed cell(s)
For Each c in rng.Cells
'check value in ColG...
If c.Offset(0, 1).Value < 0 Then
MsgBox "Cell " & c.Address & " has changed."
End If
Next c
End If
End Sub
Edit: I realize it's not exactly clear whether you want to know if there's any negative numbers in Col G, or if you want to track row-by-row. This code does the latter.
Here is the situation
Columns A through G are designed as drop down lists (data validation): Name, Number, ID, Phone, etc. Upon arrival to the office, each employee must fill their information into each cell of the row, in columns A to G.
What I want from a VBA code:
Only when each cell is filled in A:G, the date and time is stamped in the corresponding cell, in column H. It is permanent. It doesn't change ever. And once the date is stamped, the cells Columns A:G are locked as well.
My coding so far:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Target.Offset(0,1) = Now
End If
End Sub
This timestamp only works when cells in column A are changed :(
Should I be using a "case select" statement?
Is this what you are trying? (TRIED AND TESTED)
Option Explicit
'~~> Change this to the relevant password
Const MYPASSWORD As String = "BlahBlah"
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then Exit Sub
On Error GoTo Whoa
Application.EnableEvents = False
Dim rng As Range
Dim nRow As Long
nRow = Target.Row
Set rng = Range("A" & nRow & ":G" & nRow)
'~~> Check if all cell from A-G are filled and
'~~> There is no time stamp already there
If Application.WorksheetFunction.CountA(rng) = 7 _
And Len(Trim(Range("H" & nRow).Value)) = 0 Then
ActiveSheet.Unprotect MYPASSWORD
Range("H" & nRow).Value = Now
Range("A" & nRow & ":H" & nRow).Locked = True
ActiveSheet.Protect MYPASSWORD
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub