Multiple Cell Function on Cell Change

twothings

Board Regular
Joined
Jul 9, 2011
Messages
50
Office Version
  1. 365
Platform
  1. Windows
Hello

I am have a sheet that I enter large numbers eg 500,000 etc and to reduce typing zeros, I would like cells E9, E37 and E40 to be multiplied by 1000 on cell change. I can implement this with a single sub but when adding in additional subs I get an error. I have looked extensively to fix this and done much testing but require your assistance please. Can the below all be combined in to a single sub?

VBA Code:
Sub Worksheet_Change(ByVal Purchase As Range)
        Application.EnableEvents = False
        If Purchase.Address = "$E$9" Then
        Purchase = Purchase * 1000
        Application.EnableEvents = True
    End If
End Sub
Sub Worksheet_Change(ByVal LotA As Range)
        Application.EnableEvents = False
        If LotA.Address = "$E$37" Then
        LotA = LotA * 1000
        Application.EnableEvents = True
    End If
End Sub
Sub Worksheet_Change(ByVal LotB As Range)
        Application.EnableEvents = False
        If LotB.Address = "$E$40" Then
        LotB = LotB * 1000
        Application.EnableEvents = True
    End If
End Sub

Thanks
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Give this a try

VBA Code:
Sub Worksheet_Change(ByVal Purchase As Range)
    If InStr(1, ",$E$9,$E$37,$E$40,", "," & Purchase.Address & ",") > 0 Then
      Application.EnableEvents = False
      Purchase = Purchase * 1000
      Application.EnableEvents = True
    End If
End Sub
 
Upvote 0
Solution
Thank you Peter, that's working perfect; and I appreciate the tip for updating my profile.
 
Upvote 0
You're welcome. Glad it helped.
.. and thanks for updating your profile. (y)
 
Upvote 0

Forum statistics

Threads
1,224,828
Messages
6,181,204
Members
453,022
Latest member
RobertV1609

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