CODEWITHSUNDEEP
vbaexcel
Ronald Valdivia
Ronald Valdivia

Reputation: 161

VBA Excel - Modify data on cells through VBA code

I've written some VBA code to the following:

  1. Let's say that I have an spreadsheet with this columns

[Cost1] [Cost2] [Cost3] [TotalCost] [Margin%] [Margin$] [Price]

  1. If the user modifies the costs, the total cost changes and the Margin$ and Price because they depend on the cost and the Margin%
  2. If the user modifies the Price, the cost don't change but the Margin% and the Margin$ do change, because they depend on the new price.

I was not able to add protected formulas to the Price column because the user may want to change that value, thus the formula would be erased. So I decided to code VBA which works perfectly calculation wise. However, I've lost some of the most valued features of excel: e.g. If a want to copy the value of one price to several other rows, it just triggers the recalculation for the firs row where it is copied but not for the others. I'v also lost the ability of UNDO after exiting the cell.

To detect that a cell was modified I'm using the following:

Private Sub Worksheet_Change(ByVal Target As Range)
  If (Target.Column = Range("Price").Column)                 
    Call calcMargins(Target.Row)
  End If

  If (Target.Column = Range("Cost1").Column) or _
  If (Target.Column = Range("Cost2").Column) or _
  If (Target.Column = Range("Cost3").Column) or
    Call calcMargins(Target.Row)
    Call calcPrice(Target.Row)
  End If

Upvotes: 1

Views: 20548

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149287

Try this

I have deliberately broken down the code into several If statements and duplicate codes for understanding perspective. For example

        Cells(Target.Row, 4) = "Some Calculation"               '<~~ TotalCost Changes
        Cells(Target.Row, 6) = "Some Calculation"               '<~~ Margin$ Changes
        Cells(Target.Row, 7) = "Some Calculation"               '<~~ Price Changes

Please put them in a common procedure.

Also note the use of Error Handling and Application.EnableEvents. These two are a MUST when working with Worksheet_Change. Application.EnableEvents = False ensures that the code doesn't get into a possible infinite loop in case there are recursive actions. Error Handling not only handles the error but also stops the code from breaking up by showing you an error message and then resetting the Application.EnableEvents to True and finally exiting the code gracefully.

Code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns(1)) Is Nothing Then        '<~~ When Cost 1 Changes
        Cells(Target.Row, 4) = "Some Calculation"               '<~~ TotalCost Changes
        Cells(Target.Row, 6) = "Some Calculation"               '<~~ Margin$ Changes
        Cells(Target.Row, 7) = "Some Calculation"               '<~~ Price Changes

    ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then    '<~~ When Cost 2 Changes
        Cells(Target.Row, 4) = "Some Calculation"               '<~~ TotalCost Changes
        Cells(Target.Row, 6) = "Some Calculation"               '<~~ Margin$ Changes
        Cells(Target.Row, 7) = "Some Calculation"               '<~~ Price Changes

    ElseIf Not Intersect(Target, Columns(3)) Is Nothing Then    '<~~ When Cost 3 Changes
        Cells(Target.Row, 4) = "Some Calculation"               '<~~ TotalCost Changes
        Cells(Target.Row, 6) = "Some Calculation"               '<~~ Margin$ Changes
        Cells(Target.Row, 7) = "Some Calculation"               '<~~ Price Changes

    ElseIf Not Intersect(Target, Columns(7)) Is Nothing Then    '<~~ When Cost Price Changes
        Cells(Target.Row, 5) = "Some Calculation"               '<~~ Margin% Changes
        Cells(Target.Row, 6) = "Some Calculation"               '<~~ Margin$ Changes
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

I am assuming that Row 1 is protected and the user is not gonna change that. If the Header row is unprotected then you will have check for the row number withing the If Statements to exclude Row 1

FOLLOWUP

I select one of the costs (first of Cost1), do a Ctrl+C, select all cells under Cost 3 and do Crl+V, it copies the values but it only re-calculates the TotalCost for the firs cell of the selection. Than you for your help!!! – Ronald Valdivia 24 mins ago

Ah I see what you are trying :)

Use this code

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cl As Range

    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns(1)) Is Nothing Then
        For Each cl In Target
            Cells(cl.Row, 4) = Cells(cl.Row, 1) + Cells(cl.Row, 2) + Cells(cl.Row, 3)
        Next
    ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then
        For Each cl In Target
            Cells(cl.Row, 4) = Cells(cl.Row, 1) + Cells(cl.Row, 2) + Cells(cl.Row, 3)
        Next
    ElseIf Not Intersect(Target, Columns(3)) Is Nothing Then
        For Each cl In Target
            Cells(cl.Row, 4) = Cells(cl.Row, 1) + Cells(cl.Row, 2) + Cells(cl.Row, 3)
        Next
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Upvotes: 1

Related Questions