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:

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

Brak komentarzy:

Prześlij komentarz