Automatic Subtraction

[starry26]

Hi,

I want to be able to input data which will automatically be subtracted from another number.
For example, in cells E25 to E33, I want the input to be subtracted from 0.880. In cell E34 I want the input to be subtracted from 0.860.

Does this have to be done by code?

Thank you.

 

[Gerald Higgins]

Hi, welcome to the board.

It's not clear to me what you want exactly.

Are you saying that you want to input a number to cell E25, let's say the number 10, and you want that to be displayed IN CELL E25 as

-9.12

being the result of 0.880 - 10 ?

 

[starry26]

Hi, welcome to the board.

It's not clear to me what you want exactly.

Are you saying that you want to input a number to cell E25, let's say the number 10, and you want that to be displayed IN CELL E25 as

-9.12

being the result of 0.880 - 10 ?

Yes, that is correct. Cells E25 to E33: 0.880 - the number I input, and E34: 0.860 - the number I input.

 

[Gerald Higgins]

OK well it's good to get that clear.

Personally I don't know how to do this, it can probably be done with some kind of VBA but that's beyond my limited VBA skills, but probably other people on the board can help with this.

Personally, I would not do this at all - I think it could be very confusing to have an output in a cell that is completely different from the input to that same cell.
I would use helper cells - for example input the value 10 to cell E25, and in a separate cell, say F25, show the result of
=0.88-E25

 

[Joe4]

Welcome to the Board!

Here is VBA code that will do what you want. Simply right-click on the sheet tab name (at the bottom of the screen) that you want to apply this code to, select "View Code", and paste this VBA code to the resulting VB Editor window:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng1 As Range, cell1 As Range
    Dim rng2 As Range, cell2 As Range
    
'   See if updated cells fall in 1st desired range
    Set rng1 = Intersect(Target, Range("E25:E33"))
    
'   Loop through all cells changed and apply formula
    If Not rng1 Is Nothing Then
        For Each cell1 In rng1
            Application.EnableEvents = False
            cell1.Value = 0.88 - cell1.Value
            Application.EnableEvents = True
        Next cell1
    End If

'   See if updated cells fall in 2nd desired range
    Set rng2 = Intersect(Target, Range("E34:E34"))
    
'   Loop through all cells changed and apply formula
    If Not rng2 Is Nothing Then
        For Each cell2 In rng2
            Application.EnableEvents = False
            cell2.Value = 0.86 - cell2.Value
            Application.EnableEvents = True
        Next cell2
    End If

End Sub

Then, test it out by entering in some values and seeing what happens.

Note that you mentioned two ranges. You said E34 for your second one. You didn't say where that one should end, so I only have it as one cell, but you can easily modify that. You can see that you can easily add more blocks of similar code if you have more ranges.

 

[starry26]

Welcome to the Board!

Here is VBA code that will do what you want. Simply right-click on the sheet tab name (at the bottom of the screen) that you want to apply this code to, select "View Code", and paste this VBA code to the resulting VB Editor window:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng1 As Range, cell1 As Range
    Dim rng2 As Range, cell2 As Range
    
'   See if updated cells fall in 1st desired range
    Set rng1 = Intersect(Target, Range("E25:E33"))
    
'   Loop through all cells changed and apply formula
    If Not rng1 Is Nothing Then
        For Each cell1 In rng1
            Application.EnableEvents = False
            cell1.Value = 0.88 - cell1.Value
            Application.EnableEvents = True
        Next cell1
    End If

'   See if updated cells fall in 2nd desired range
    Set rng2 = Intersect(Target, Range("E34:E34"))
    
'   Loop through all cells changed and apply formula
    If Not rng2 Is Nothing Then
        For Each cell2 In rng2
            Application.EnableEvents = False
            cell2.Value = 0.86 - cell2.Value
            Application.EnableEvents = True
        Next cell2
    End If

End Sub

Then, test it out by entering in some values and seeing what happens.

Note that you mentioned two ranges. You said E34 for your second one. You didn't say where that one should end, so I only have it as one cell, but you can easily modify that. You can see that you can easily add more blocks of similar code if you have more ranges.

That's perfect. THANK YOU!

 

[Joe4]

You are welcome!

 

[starry26]

How do I apply this to the entire workbook?

 

[Joe4]

You would modify the code slightly, and put it in the "ThisWorkbook" module instead of the specific "Sheet" module.
So that code would look like this:

[COLOR=#ff0000]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)[/COLOR]

    Dim rng1 As Range, cell1 As Range
    Dim rng2 As Range, cell2 As Range
    
'   See if updated cells fall in 1st desired range
    Set rng1 = Intersect(Target, [COLOR=#ff0000]Sh.[/COLOR]Range("E25:E33"))
    
'   Loop through all cells changed and apply formula
    If Not rng1 Is Nothing Then
        For Each cell1 In rng1
            Application.EnableEvents = False
            cell1.Value = 0.88 - cell1.Value
            Application.EnableEvents = True
        Next cell1
    End If

'   See if updated cells fall in 2nd desired range
    Set rng2 = Intersect(Target, [COLOR=#ff0000]Sh.[/COLOR]Range("E34:E34"))
    
'   Loop through all cells changed and apply formula
    If Not rng2 Is Nothing Then
        For Each cell2 In rng2
            Application.EnableEvents = False
            cell2.Value = 0.86 - cell2.Value
            Application.EnableEvents = True
        Next cell2
    End If
    
End Sub

The differences are in red font.