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