add another condition to an event change ?

[StrawberryDreams]

Hi I have a range of three cells (D7:D10) that are being Sum'd and the result is being placed in a "total" cell above them (D6). The VBA is on the worksheet form so that it happens as an event change anytime the range of cells are changed. Everything works great and I would still like to maintain the auto sum capability of the range, but I would like to modify a couple things:

1 - Currently the user can change the "total", cell (D6) value to whatever value they want which I am ok with , ( this way the User can enter their own "total" without having to rely on inputting data into the range as an option), but if they do that , would like the range of cells to clear if they have data.

2 - If the User clears the total in D6, currently data in the range cells remain, and would like those to be cleared as well.

3- How would I write the sum range code more eloquently so that it still places the value of the range in D6 instead of writing a range formula which will place a visible formula in the cell formula bar. Just thinking in cases if I have many cells to add to a range.

Private Sub Worksheet_Change(ByVal Target As Range)


Dim rangeToChange As Range

Set rangeToChange = Range("D7:D10")


'when range of cells are changed, SUM Range total and place result in D6
'Cell D6 is the subtotal of D7:D10

    If Not Intersect(Target, rangeToChange) Is Nothing Then
    
        Range("D6").Value = Range("D7") + Range("D8") + Range("D9") + Range("D10")
        
        End If
        
End Sub

 

[Joe4]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rangeToChange1 As Range
    Dim rangeToChange2 As Range
    Dim cell As Range
    Dim tot As Double

    Set rangeToChange1 = Range("D6")        'total range
    Set rangeToChange2 = Range("D7:D10")    'cells to total

'   See if change made to cell D6
    If Not Intersect(Target, rangeToChange1) Is Nothing Then
'       Clear range D7:D10
        Application.EnableEvents = False
        rangeToChange2.ClearContents
        Application.EnableEvents = True
        Exit Sub
    End If

'   See if change is made to cells D7:D10
    If Not Intersect(Target, rangeToChange2) Is Nothing Then
'       Sum up values in range and update cell D6
        tot = 0
        For Each cell In rangeToChange2
            tot = tot + cell.Value
        Next cell
        
        Application.EnableEvents = False
        rangeToChange1 = tot
        Application.EnableEvents = True
    End If
        
End Sub

You can easily change the range references at the top at the rest of the code will follow.

 

[StrawberryDreams]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rangeToChange1 As Range
    Dim rangeToChange2 As Range
    Dim cell As Range
    Dim tot As Double

    Set rangeToChange1 = Range("D6")        'total range
    Set rangeToChange2 = Range("D7:D10")    'cells to total

'   See if change made to cell D6
    If Not Intersect(Target, rangeToChange1) Is Nothing Then
'       Clear range D7:D10
        Application.EnableEvents = False
        rangeToChange2.ClearContents
        Application.EnableEvents = True
        Exit Sub
    End If

'   See if change is made to cells D7:D10
    If Not Intersect(Target, rangeToChange2) Is Nothing Then
'       Sum up values in range and update cell D6
        tot = 0
        For Each cell In rangeToChange2
            tot = tot + cell.Value
        Next cell
       
        Application.EnableEvents = False
        rangeToChange1 = tot
        Application.EnableEvents = True
    End If
       
End Sub

You can easily change the range references at the top at the rest of the code will follow.

Cool thanks Joe, I'll try this out. Before you posted I just added another If statement which seems to work, but maybe it's not advisable to do it this way for some reason.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rangeToChange As Range

Set rangeToChange = Range("D7:D10")

'when range of cells are changed, SUM Range total and place result in D6
'Cell D6 is the subtotal of D7:D10

    If Not Intersect(Target, rangeToChange) Is Nothing Then
    
        Range("D6").Value = Range("D7") + Range("D8") + Range("D9") + Range("D10")
        
        End If

'If D6 is erased by User then clear data from range
        If Range("D6").Value = "" Then
        rangeToChange = ""
        
        End If
End Sub

 

[Joe4]

That doesn't really follow what you said for your third item (not very flexible - things are hard-coded).

You are also invoking multiple unnecessary calls/loops to this code to run multiple times, as the changes you make to the range D6:D10 will call this event code to call itself, unless you temporarily disable events, with a line like this:

        Application.EnableEvents = False

and then turn them back on after the changes have been made, i.e.

        Application.EnableEvents = True

 

[Joe4]

You need to be careful when working with "Worksheet_Change" event procedures and you are updating the same cells that you are watching.
If you are not careful, you can program yourself into an infinite loop and lock up your computer and/or crash your system!

So it is usually wise to temporarily disable events while the code is updating cells, so it doesn't call itself by the very changes it is making.

 

[StrawberryDreams]

You need to be careful when working with "Worksheet_Change" event procedures and you are updating the same cells that you are watching.
If you are not careful, you can program yourself into an infinite loop and lock up your computer and/or crash your system!

So it is usually wise to temporarily disable events while the code is updating cells, so it doesn't call itself by the very changes it is making.

that's good to know, thanks for sharing. If in the future I want to add additional ranges on this same worksheet with a different total cell , Im guessing I should be able to just copy your similar lines of if codes, after yours - granted Ive defined the additional ranges too ?

 

[StrawberryDreams]

@Joe4 Is being aware of this possible issue with locking loops similar to how Bi-Directional cell relationships work ? Ex. if you enter a value in A1 it convert properly to A2& A3, if you change a value in A2 it will convert properly A1 & A3 etc.

A1 = 5000 grams
A2 = 5 kg
A3 = 11 lbs

 

[Joe4]

@Joe4 Is being aware of this possible issue with locking loops similar to how Bi-Directional cell relationships work ? Ex. if you enter a value in A1 it convert properly to A2& A3, if you change a value in A2 it will convert properly A1 & A3 etc.

A1 = 5000 grams
A2 = 5 kg
A3 = 11 lbs

If you are watching all 3 cells for updates, and wanting to update the other 2 cells based on the change made, you should definitely disable the events while your code makes those changes.

 

[StrawberryDreams]

If you are watching all 3 cells for updates, and wanting to update the other 2 cells based on the change made, you should definitely disable the events while your code makes those changes.

great ! One other question what does the exit Sub do after your first IF statement ?
If you didn't have it would it just move onto the next possible If and then eventually End sub?

You're the GOAT!

 

[Joe4]

The "Exit Sub" lines does exactly what you think it does - it exits the code right at that point, if it gets to that line.
The code may work fine with or without it most of the time, but I just wanted to eliminate the possibility of both "blocks" of code ending.
If D6 is updated, the first block is invoked, and there is no need to even check the second one.

However, it is possible that you could update all the cells in D6:D10 at the same time (i.e. through copy/paste, or by clearing all the contents at the same time).
If that happens, that line ensures that only the first block will run.