Bi-directional formula

anites

New Member
Joined
Feb 16, 2024
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hello everyone, I'm currently trying to find a code that would allow me to make a simple operation than works in two ways. I found an old thread from 2011 that answered the question, but I would like to apply the formula to a range of cells and not just the 3 shown in here.

The code is:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   
    Application.EnableEvents = False
   
    If Target.Address(0, 0) = "B2" Then [D2] = Target - [F2]
    If Target.Address(0, 0) = "D2" Then [B2] = Target + [F2]
   
    Application.EnableEvents = True
   
End Sub

Although I would not use this very same formula, the concept is exactly the same, but I need to apply it to a certain range within a column, B2:B33, D2:D33 and F2:F33 to be precise.

I'm new to VBA and I tried everything within my knowledge but I just can't seem to pull this off.

Thanks in avadvance.
 
Last edited by a moderator:

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time. 😊

Give this a try with a copy of your workbook

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range, c As Range
  
  Set Changed = Intersect(Target, Union(Range("B2:B33"), Range("D2:D33")))
  If Not Changed Is Nothing Then
    Application.EnableEvents = False
    For Each c In Changed
      If c.Column = 2 Then
        c.Offset(, 2).Value = c.Value - c.Offset(, 4).Value
      Else
        c.Offset(, -2).Value = c.Value - c.Offset(, 2).Value
      End If
    Next c
    Application.EnableEvents = True
  End If
End Sub
 
Upvote 0
When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time. 😊

Give this a try with a copy of your workbook

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range, c As Range
 
  Set Changed = Intersect(Target, Union(Range("B2:B33"), Range("D2:D33")))
  If Not Changed Is Nothing Then
    Application.EnableEvents = False
    For Each c In Changed
      If c.Column = 2 Then
        c.Offset(, 2).Value = c.Value - c.Offset(, 4).Value
      Else
        c.Offset(, -2).Value = c.Value - c.Offset(, 2).Value
      End If
    Next c
    Application.EnableEvents = True
  End If
End Sub
Thanks a lot Peter, I really appreciate the feedback. It seems to works perfectly fine, now it's only a matter of adapting the formulas a tiny bit :)
 
Upvote 0
You're welcome. Post back with details if you have trouble adapting.
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top