VBA to Multiply Cell Value Automatically in Same Cell If Condition Met

seanmic

New Member
Joined
Jan 2, 2016
Messages
12
Hello,

I have a workbook where users are required to enter values in Range A2:A1000. If the value entered in the range is less than 100, I'd like the value to be automatically multiplied by 2080 in the exact same cell where it was typed. If, however, the user enters a value greater than or equal to 100, then the value would would be unchanged and would show in the cell exactly as typed.

Here's the code I currently have... could someone please help me to modify it so it can handle the criteria above?

Code:
Private changeFlag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Column = 1 And Not changeFlag Then
        changeFlag = True
        intcolumn = Target.Column
        introw = Target.Row
        Cells(introw, intcolumn).Value = Cells(introw, intcolumn).Value * 2080
    Else
        changeFlag = False
    End If
End Sub

Thanks in advance for your help
~Sean
 
Last edited:

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

jproffer

Well-known Member
Joined
Dec 15, 2004
Messages
2,643
I personally wouldn't worry about that changeFlag stuff.

This is untested since I'm at home and my only access to Excel is at work, but give it a shot.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Column = 1 and Target.Value < 100 Then
        Target.Value = Target.Value * 2080
    Else
        Target.Value = Target.Value
    End If
End Sub

and really you could probably drop the Else part of the If statement. Just

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Column = 1 and Target.Value < 100 Then
        Target.Value = Target.Value * 2080
    End If
End Sub
 
Last edited:

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,445
Office Version
  1. 2013
Platform
  1. Windows
I would modify @jproffer code like

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR=#b22222]Application.EnableEvents = False[/COLOR]
    If Target.Column = 1 and Target.Value < 100 Then
        Target.Value = Target.Value * 2080
    Else
        Target.Value = Target.Value
    End If
[COLOR=#b22222]Application.EnableEvents = True[/COLOR]
End Sub
To avoid perpetual loop when the value is < 100. Depends on whether Excel sees the multiplication as a calculation or a change. And you don't really need the Else part of the statement. The value would be what the user enters if it >=100.
 
Last edited:

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,831
Office Version
  1. 2013
Platform
  1. Windows
Try this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 3-1-18 8:30 PM EST
If Not Intersect(Target, Range("A2:A1000")) Is Nothing Then
Application.EnableEvents = False
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If IsNumeric(Target.Value) Then
Dim ans As Long
ans = Target.Value
If ans < 100 Then ans = (ans * 2080): Target.Value = ans
End If
Application.EnableEvents = True
End If
End Sub
 

seanmic

New Member
Joined
Jan 2, 2016
Messages
12

ADVERTISEMENT

Thank you all for all your help!

I tried each of the versions and found that they all worked... until I cleared contents. When I cleared contents, I either received run type error 13, or it simply didn't execute the script. Is there a way to handle when cells are cleared out, so that the code continues to run?
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,831
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Try this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 3-6-18 3:40 PM EST
If Not Intersect(Target, Range("A2:A1000")) Is Nothing Then
Application.EnableEvents = False
If Target.Cells.Count > 1 Or IsEmpty(Target) Then: Application.EnableEvents = True: Exit Sub
If IsNumeric(Target.Value) Then
Dim ans As Long
ans = Target.Value
If ans < 100 Then ans = (ans * 2080): Target.Value = ans
End If
Application.EnableEvents = True
End If
End Sub
 

seanmic

New Member
Joined
Jan 2, 2016
Messages
12
Try this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 3-6-18 3:40 PM EST
If Not Intersect(Target, Range("A2:A1000")) Is Nothing Then
Application.EnableEvents = False
If Target.Cells.Count > 1 Or IsEmpty(Target) Then: Application.EnableEvents = True: Exit Sub
If IsNumeric(Target.Value) Then
Dim ans As Long
ans = Target.Value
If ans < 100 Then ans = (ans * 2080): Target.Value = ans
End If
Application.EnableEvents = True
End If
End Sub


This code worked perfectly.... I wish I could write VBA like this! Thank you so much for helping me out :biggrin:
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,831
Office Version
  1. 2013
Platform
  1. Windows
This code worked perfectly.... I wish I could write VBA like this! Thank you so much for helping me out :biggrin:
Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.
 

Rosher

New Member
Joined
Mar 5, 2020
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
My query is similar to the original poster but there is slight difference. I want the Range A2:A1000 to be multiplied but not by a fixed value say
2080(in this case) but i want the Range A2:A1000 to be multiplies by values in range B2:B1000. I tried and found one of the above code is working find for fixed value but not working for my query. This is the above code which i have tried :

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 3-1-18 8:30 PM EST
If Not Intersect(Target, Range("A2:A1000")) Is Nothing Then
Application.EnableEvents = False
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If IsNumeric(Target.Value) Then
Dim ans As Long
ans = Target.Value
If ans < 100 Then ans = (ans * 2080): Target.Value = ans
End If
Application.EnableEvents = True
End If
End Sub

Please help me, how can i get the values in Range A2:A1000 to be multiplies by values in range B2:B1000. I have Item cost price mentioned in column A and Qty mentioned in column B. Currently the qty in B column is fixed to 1. So what i want is - whenever the qty in B column increases the cost in column should increase too ie A2*B2. So in short i want, A2=A2*B2. So now if value in B2 changes, A2 should change automatically.
 

Watch MrExcel Video

Forum statistics

Threads
1,109,075
Messages
5,526,667
Members
409,714
Latest member
diamondjoechubbs

This Week's Hot Topics

Top