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

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.

Related

Add a text to an existing cell

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

change the range of function automatically when rows are added

[1
I wrote =sum(A2:A11) in cell A1, and I wrote random numbers in A2:A11. Then I deleted some rows and then the A1 cell's range changed automatically. But I don't understand why the range does not change automatically when I add new rows and intert new values. How can I make it change automatically? Do I have to use vba to do this?
A Worksheet Change Event: Monitor Change in Column's Data
I personally would go with JvdV's suggestion in the comments.
On each manual change of a cell, e.g. in column A, it will check the formula
=SUM(A2:ALastRow) in cell A1 and if it is not correct it will overwrite it with the correct one.
You can use this for multiple non-adjacent columns e.g. "A,C:D,E".
Nothing needs to be run. Just copy the code into the appropriate sheet module e.g. Sheet1 and exit the Visual Basic Editor.
Sheet Module e.g. Sheet1 (not Standard Module e.g. Module1)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
UpdateFirstRowFormula Target, "A"
End Sub
Private Sub UpdateFirstRowFormula( _
ByVal Target As Range, _
ByVal ColumnList As String)
On Error GoTo ClearError
Dim ws As Worksheet: Set ws = Target.Worksheet
Dim Cols() As String: Cols = Split(ColumnList, ",")
Application.EnableEvents = False
Dim irg As Range, arg As Range, crg As Range, lCell As Range
Dim n As Long
Dim Formula As String
For n = 0 To UBound(Cols)
With ws.Columns(Cols(n))
With .Resize(.Rows.Count - 1).Offset(1)
Set irg = Intersect(.Cells, Target.EntireColumn)
End With
End With
If Not irg Is Nothing Then
For Each arg In irg.Areas
For Each crg In arg.Columns
Set lCell = crg.Find("*", , xlFormulas, , , xlPrevious)
If Not lCell Is Nothing Then
Formula = "=SUM(" & crg.Cells(1).Address(0, 0) & ":" _
& lCell.Address(0, 0) & ")"
With crg.Cells(1).Offset(-1)
If .Formula <> Formula Then .Formula = Formula
End With
End If
Next crg
Next arg
Set irg = Nothing
End If
Next n
SafeExit:
If Not Application.EnableEvents Then Application.EnableEvents = True
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub
Use a nested function as below:
=SUM(OFFSET(A2,,,COUNTA(A2:A26)))

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.

Go to matching cell in a row range based on drop down list

I have a list of names in a row, A2 to AAS2, I also have a drop-down list containing all of those names. I would like some VBA code that when the list is changed excel jumps to the cell matching the item in the list. Could someone please help me with this? Thank you.
The names are just text, no named ranges.
Here is what I have tried so far:
Private Sub FindTicker()
Dim MyVariable As String
MyVariable = Range("L1").Value
Application.Goto Reference:=Range(MyVariable)
End Sub
And Also
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> [L1].Address Then
Exit Sub
Else
JumpToCell
End If
End Sub
Sub JumpToCell()
Dim xRg, yRg As Range
Dim strAddress As String
strAddress = ""
Set yRg = Range("A2:AAS2")
For Each xRg In yRg
'MsgBox Cell.Value
If xRg.Value = ActiveCell.Value Then
strAddress = xRg.Address
End If
Next
If strAddress = "" Then
MsgBox "The Day You Selected in Cell D4 Was Not Found On " & ActiveSheet.Name, _
vbInformation, "Ticker Finder"
Exit Sub
Else
Range(strAddress).Offset(0, 1).Select
End If
End Sub
When I tried using both of these when I changed the drop-down list nothing happened. No errors or anything.
Lots of ways to do this and with some tweaks your code above could work but its a bit inefficient and more complicated than it needs to be. The simplest way would be to use the Find method of the Range class to locate the cell:
Lets say your drop-down list of names is in cell A1 on sheet MySheet and the long list is in column C. Use the Find method to set a range variable to equal the first cell containing the item in cell A1.
Dim rng As Range
Dim ws As Worksheet
Set ws = Sheets("MySheet")
Set rng = ws.Range("C:C").Cells.Find(ws.Range("A1"), lookat:=xlWhole)
If Not rng Is Nothing Then ' the item was found
rng.Select
Else
MsgBox "This item is not in the list", vbInformation
End If

vba#excel_highlight the empty cells

I'm creating an excel file with column A to H are mandatory cells.
This excel file will be passing around for input.
So, I would like to highlight the empty cells as a reminder.
I have written the following code...
Sub Highlight_Cell()
Dim Rng As Range
For Each Rng In Range("A2:H20")
If Rng.Value = "" Then
Rng.Interior.ColorIndex = 6 ‘yellow
Else
Rng.Interior.ColorIndex = 0 'blank
End If
Next Rng
MsgBox "Please fill in all mandatory fields highlighted in yellow."
End Sub
However, I would like to set the range from A2 to the last row that contains data within column A to H.
Also, display the message box only when empty cell exist.
Could you please advise how should I amend?
Million Thanks!!!
This is a VBA solution that prevents the user from saving until the desired range is filled (acknowledging Gserg's comment that that the last row is one that has at least one cell entered)
In the second portion you can either add your sheet index directly, Set ws = Sheets(x) for position x, or Set ws = Sheets("YourSheet") for a specific sheet name
The code will only highlight truly blank cells within A to H of this sheet till the last entered cell (using SpecialCells as a shortcut). Any such cells will be selected by the code on exit
Put this code in the ThisWorkbook module (so it fires whenever the user tries to close the file)
Private Sub Workbook_BeforeClose(Cancel As Boolean)
bCheck = False
Call CheckCode
If bCheck Then Cancel = True
End Sub
Put this code in a standard module
Public bCheck As Boolean
Sub CheckCode()
Dim ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
bCheck = False
'works on sheet 1, change as needed
Set ws = Sheets(1)
Set rng1 = ws.Columns("A:H").Find("*", ws.[a1], xlValues, xlWhole, xlByRows)
If rng1 Is Nothing Then
MsgBox "No Cells in columns A:H on " & ws.Name & " file will now close", vbCritical
Exit Sub
End If
Set rng2 = ws.Range(ws.[a1], ws.Cells(rng1.Row, "H"))
On Error Resume Next
Set rng2 = rng2.SpecialCells(xlBlanks)
On Error GoTo 0
If rng2 Is Nothing Then Exit Sub
bCheck = True
rng2.Interior.Color = vbYellow
MsgBox "Please fill in all mandatory fields on " & ws.Name & " highlighted in yellow", vbCritical, "Save Cancelled!"
Application.Goto rng2.Cells(1)
End Sub

Resources