My code works with a listobject.table and is intended to allow editing prices and calculating discounts or vice versa...
On entering the cell for editing it turns the formula therein into a value and pastes the formula in another column.
It works like a charm when the user is editing cells. But if the user tries to add rows to the listobject.table, the macro ruins the table. It adds a couple of columns and some headers are replaced.
Is it possible to make the macro somehow to disregard the operation of adding new rows or extending the range of data.table?
Here is the macro, thank you my friends for advice:
Private oListObj As ListObject
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set oListObj = Worksheets("Quotation").ListObjects("tblProForma")
Application.EnableEvents = True
If Not Intersect(Target, oListObj.ListColumns("Price").DataBodyRange) Is Nothing Then
Application.EnableEvents = False
Application.AutoCorrect.AutoFillFormulasInLists = False
Target.Formula = Target.Value
Application.EnableEvents = True
End If
If Not Intersect(Target, oListObj.ListColumns("Discount").DataBodyRange) Is Nothing Then
Application.EnableEvents = False
Application.AutoCorrect.AutoFillFormulasInLists = False
Target.Formula = Round(Target.Value, 5)
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PriceDiscountOffset As Integer: PriceDiscountOffset = ActiveSheet.Range("tblProForma[[#All],[Price]:[Discount]]").Columns.Count - 1
Set oListObj = Worksheets("Quotation").ListObjects("tblProForma")
Application.EnableEvents = True
If Not Intersect(Target, oListObj.ListColumns("Price").DataBodyRange) Is Nothing Then
Application.EnableEvents = False
Application.AutoCorrect.AutoFillFormulasInLists = False
Target.Offset(0, PriceDiscountOffset).Formula = "=IF([#[Price]]<>"""", -([#[Price]]-[#[Pricelist]])/[#[Price]],"""")"
Application.EnableEvents = True
End If
If Not Intersect(Target, oListObj.ListColumns("Discount").DataBodyRange) Is Nothing Then
Application.EnableEvents = False
Application.AutoCorrect.AutoFillFormulasInLists = False
Target.Offset(0, -PriceDiscountOffset).Formula = "=[#[Pricelist]]-([#[Pricelist]]*[#[Discount]])"
Application.EnableEvents = True
End If
End Sub
Related
I am new to macros and I right this macro to lock and unlock specific cells according to values from others:
Private Sub Worksheet_Change(ByVal Target As range)
If [$A1] = "Yes" Then
ActiveSheet.Unprotect ("")
[$E:$E].locked = True
[$F:$F].locked = True
[$N:$N].locked = True
[$O:$O].locked = True
[$P:$P].locked = True
[$X:$X].locked = True
[$Y:$Y].locked = True
[$Z:$Z].locked = True
[$AA:$AA].locked = True
[$AB:$AB].locked = True
[$AC:$AC].locked = True
ActiveSheet.Protect ("")
Else
ActiveSheet.Unprotect ("PASSWORD")
[$E:$E].locked = False
[$F:$F].locked = False
[$N:$N].locked = False
[$O:$O].locked = False
[$P:$P].locked = False
[$X:$X].locked = False
[$Y:$Y].locked = False
[$Z:$Z].locked = False
[$AA:$AA].locked = False
[$AB:$AB].locked = False
[$AC:$AC].locked = False
ActiveSheet.Protect ("")
End If
If [$A1] = "No" Then
ActiveSheet.Unprotect ("")
[$B:$B].locked = True
ActiveSheet.Protect ("")
Else
ActiveSheet.Unprotect ("")
[$B:$B].locked = False
ActiveSheet.Protect ("")
End If
End Sub
By $A1 I mean to run the macro on all cells in column A and lock range of columns.
I don't know how to run and test and see if there any errors.
EDIT: i tried this and still can't test it or see how to work with it
Private Sub Worksheet_Change(ByVal Target As range)
If range("A1") = "Yes" Then
range("B1:B4").locked = True
ElseIf range("A1") = "No" Then
range("B1:B4").locked = False
End If
End Sub
Firstly the routine only makes sense if the cell that has changed is A1 - we should ignore this for any other cell.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Dim LockCells As Boolean
LockCells = (UCase(ActiveSheet.Range("A1")) = "YES")
Dim ColsToLock
ColsToLock = Split("E,F,N,O,P,X,Y,Z,AA,AB,AC", ",")
Dim r As Range
Dim x As Integer
ActiveSheet.Unprotect ""
For x = 0 To UBound(ColsToLock) - 1
Set r = ActiveSheet.Columns(ColsToLock(x) & ":" & ColsToLock(x))
r.Locked = LockCells
Next x
ActiveSheet.Protect ""
End If
End Sub
Secondly don't forget to unprotect all cells before you start
I want to lock cell B20 and write "1" on it if I choose a certain option ("T") on the dropdown of B18. If I choose any other option, I want to be able to fill it normally without any limitations. Here is the best code I tried:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = ActiveSheet
If Target.Address = "$B$18" Then
ws.Unprotect
Application.EnableEvents = False
Target.Offset(1).Locked = Target.Value = "T"
If Target.Value = "T" Then
Target.Offset(1).Value = 1
Else
If Target.Offset(1).Value = 1 Then Target.Offset.Value = ""
End If
Application.EnableEvents = True
ws.Protect
End If
End Sub
This code is doing exactly what I want but its performing this on the cell B19 instead of B20.
Can somebody help me please?
There is a bunch of code and text all saying different things in your question, so I based this code on your comment and the text of your question.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$18" Then
ws.Unprotect
Application.EnableEvents = False
Target.Offset(2).Locked = Target.Value = "T"
If Target.Value = "T" Then
Target.Offset(2).Value = 1
Else
If Target.Offset(2).Value = 1 Then Target.Offset.Value = ""
End If
Application.EnableEvents = True
ws.Protect
End If
End Sub
I would like to run a macro automatically when a cell changed(its value is equal or greater than "1") on G1:G500 Range.
I partially succeeded but;
It only works for one specific cell.
I could not write which tells it is equal or greater than 1. It only works if cell value is equal to 1.
I am truly sorry since I am a beginner at VBA. Helps appreciated.
Please see the whole code below;
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G12")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
With Application
.EnableEvents = False
.ScreenUpdating = False
If UCase(Me.Range("G12").Value) = "1" Then
Call K999
End If
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Try:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G1:G500")) Is Nothing Then
If Target = "" Then Exit Sub
On Error GoTo GetOut
With Application
.EnableEvents = False
.ScreenUpdating = False
If Target.Value >= 1 Then
Call K999
End If
End With
End If
GetOut:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'[1]
If Intersect(Target, Range("G1:G500")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
'[2]
If Not IsNumeric(Target.Value) Then Exit Sub
With Application
.EnableEvents = False
.ScreenUpdating = False
'[3]
If Target.Value >= 1 Then
Call K999
End If
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Intersect(Target, Range("G12")) checks the target is G12 or not, according to your statement, it should be Range("G1:G500")
Since you cannot force the user type a number into the cell, it is safer to check the value is number or not first.
"1" is a string, 1 is a number. No need to transtype into string then compare two string.
I have a protected workbook. It works perfectly fine. Until we counter the below error.
Data validation is used on one of the cells, where the user is not allowed to enter a date before 01/01/1970 and it throws an error when we do so.
But the concern is when we click on "Retry or cancel". I get runtime error which is causing the problem. Once we encounter the error it affects other fields with VBA enabled(VBA on other fields will not work until we close and open a fresh spreadsheet). How do we handle such error?
Please suggest
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim myValue
With Application
myValue = Target.Formula
.Undo
Target.Formula = myValue
End With
Application.CutCopyMode = False
If Not Intersect(Target, Range("E43")) Is Nothing Then
With Range("E44")
If Target.Value = "Specific Number of Days" Then
.Locked = False
.Activate
Else
'This handles **ANY** other value in the dropdown
.Locked = True
'.Clear
End If
End With
ElseIf Not Intersect(Target, Range("E30")) Is Nothing Then
If Target.Value = "YES" Then Call Notify Else Call NotifyUser
ElseIf Not Intersect(Target, Range("E31")) Is Nothing Then
If Target.Value = "YES" Then Call Delta Else Call DeltaUser
End If
Application.EnableEvents = True
End Sub
I'm working on an Excel worksheet and using VBA to complete and update information on the cells.
There are seven columns in the Excel table. Three of them are drop-down lists with Data Validation, which I used the following VBA code to fill them.
Private Sub TempCombo_KeyDown(ByVal _KeyCode As MSForms.ReturnInteger, _ ByVal Shift As Integer)
'Ocultar caixa de combinação e mover a próxima célula com Enter e Tab
Select Case KeyCode
Case 9
ActiveCell.Offset(0, 1).Activate
Case 13
ActiveCell.Offset(1, 0).Activate
Case Else
'Nada
End Select
End Sub
These columns also work with autocomplete, using the code below:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Set ws = ActiveSheet
Set wsList = Sheets(Me.Name)
Application.EnableEvents = False
Application.ScreenUpdating = False
If Application.CutCopyMode Then
'Permite copiar e colar na planilha
GoTo errHandler
End If
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'Abrir a lista suspensa automaticamente
Me.TempCombo.DropDown
End If
errHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
End Sub
Anytime I update any cell on a row, I want that the content of the seventh column of this row is updated with the current date.
I tried using the following code, but it only works with common cells, the ones that I manually type its content. I want the seventh column to be updated when I change the drop-down list selection also.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 Then Exit Sub
Application.EnableEvents = False
Cells(Target.Row, "U").Value = Date
End Sub
Is there any way to update the content of the column as I said before? Even when I change the option selected in the drop-down list?
Your code is fine except that you need to turn events back on. You have stopped events from firing with this line: Application.EnableEvents = False but you never turn the event firings back on again. So your code will work the first time you change a cell, the Worksheet_Change event will fire as expected. However, within this sub you have set EnableEvents to false and then never set it back to true. So you have stopped all future events, including this one, from firing again in the future. Here is the solution:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 Then Exit Sub
Application.EnableEvents = False
Cells(Target.Row, "U").Value = Date
Application.EnableEvents = True
End Sub