How to find values for 1st cell of same row for a target in Excel VBA? - excel

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)

Related

How do I execute instructions only if the cell value change?

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.

VBA type mismatch when value is calculated by a formula in the cell

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.

Same VBA code in the same worksheet for 2 different sets of table the first works, the second doesnt

I found the below code to input a timestamp automatically when one specific range has anything written and I wanted to do this in 2 specific places within the same worksheet, hence I wrote the same sequence, however the 1st works and the second doesnt, below my code:
Private Sub Worksheet_Change(ByVal Target As Range)
'==============logdate timestamp completed============
Dim myTableRange As Range
Dim myDayTimeRange As Range
'my Data Table Range
Set myTableRange = Range("E:E")
If Not Intersect(Target, myTableRange) Is Nothing Then
'Column for the date
Set myDateTimeRange = Range("A" & Target.Row)
If myDateTimeRange.Value = "" Then
myDateTimeRange.Value = Now
End If
End If
'==============logdate timestamp inflight============
Dim myTableRangeif As Range
Dim myDayTimeRangeif As Range
'my Data Table Range
Set myTableRangeif = Range("N19:R19")
If Not Intersect(Target, myTableRangeif) Is Nothing Then
'Column for the date
Set myDateTimeRangeif = Range("J" & Target.Row)
If myDateTimeRangeif.Value = "" Then
myDateTimeRangeif.Value = Now
End If
End If
End Sub
Just changed the code as suggested however the timestamp appears on the "A" column but not on the "J" one
When you change something in Range("N19:R19"), the Exit Sub is executed because it is true that Intersect(Target, myTableRange) Is Nothing.
You need to change the logic of Exiting the Sub if the Intersection is nothing.
If Not Intersect(Target, myTableRange) Is Nothing Then
'Column for the date
Set myDateTimeRange = Range("A" & Target.Row)
If myDateTimeRange.Value = "" Then
myDateTimeRange.Value = Now
End If
End If
...
If Not Intersect(Target, myTableRangeif) Is Nothing Then
'Column for the date
Set myDateTimeRangeif = Range("J" & Target.Row)
If myDateTimeRangeif.Value = "" Then
myDateTimeRangeif.Value = Now
End If
End If

When copying bulk values into cell macro is not updating

Currently using this macro cell template off Microsoft, it works perfectly when I input data into the B column one by one but when I try to copy and paste data into B1:B10 the macro will not run and column A will not update. Also If I wanted the same macro for another range column would I have to make another function exact same and change the Set KeyCells = Range( : ) or can I add in a conditional statement in the same function?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("B1:B1000")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Cells(Target.Row, 2).Value = "A" Then
Cells.(Target.Row, 1).Value = "AA"
End If
If Cells(Target.Row, 2).Value = "B" Then
Cells.(Target.Row, 1).Value = "BB"
End If
End If
End Sub
Loop the intersection of the target cells and the desired range.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Intersect(Range("B1:B1000"), Target)
If Not KeyCells Is Nothing Then
Dim rng As Range
For Each rng In KeyCells
If rng.Value = "A" Then
rng.Offset(0, -1).Value = "AA"
ElseIf rng.Value = "B" Then
rng.Offset(0, -1).Value = "BB"
End If
Next rng
End If
End Sub

Error 424 : Object required _ setting Table as a range

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

Resources