Private oListObj As ListObject
'Private Sub Worksheet_Activate()
' ActiveSheet.Protect "pwd", AllowFiltering:=True
'End Sub
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
'=============
'This code prevents macro from ruining table if user resizes it.
'=============http://www.mrexcel.com/forum/excel-questions/844654-can-i-tell-excel-run-macro-every-time-i-manually-resize-listobject-excel-table.html
Dim sLastUndoStackItem As String
On Error Resume Next
sLastUndoStackItem = Application.CommandBars("Standard").FindControl(ID:=128).List(1)
On Error GoTo 0
If sLastUndoStackItem = "Table Resize" Then
Exit Sub
End If
'=============
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
czwartek, 7 stycznia 2016
Excel VBA: changing value calculates discount, changing discount calculates value.
We want to enter values and have discount calculated in another column. On the other hand we want to change discount and have value calculated... We need VBA and sheet events:
Subskrybuj:
Komentarze do posta (Atom)
Brak komentarzy:
Prześlij komentarz