VBA code to Multiply Cell Value In First Cell Automatically With Cell Value In Another Cell And Get Result In Same Cell

Rosher

New Member
Joined
Mar 5, 2020
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
My query is similar to the original poster here - VBA to Multiply Cell Value Automatically in Same Cell If Condition Met
but there is slight difference in my case. I want the Range A2:A1000 to be multiplied but not by a fixed value say
2080(in that 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 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 (say from 1 to 2) 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.
 

Some videos you may like

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,125
Office Version
  1. 365
Platform
  1. Windows
How about
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then
      Target.Offset(, -1).Value = Target.Offset(, -1) * Target.Value
   End If
End Sub
 

Rosher

New Member
Joined
Mar 5, 2020
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
How about
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then
      Target.Offset(, -1).Value = Target.Offset(, -1) * Target.Value
   End If
End Sub
Thanks a lot bro, its working perfectly fine.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,125
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback
 

My Aswer Is This

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

ADVERTISEMENT

I answered your question in the other posting where you asked me. But my script did not know you wanted the script activated when you made a change to column 2 instead of column 1 which was what my original post did. But glad you now have a answer that works for you.
 

Rosher

New Member
Joined
Mar 5, 2020
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
How about
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then
      Target.Offset(, -1).Value = Target.Offset(, -1) * Target.Value
   End If
End Sub
This code has resolved my issue. If i increase the qty from 1 to anything else the cost price gets multiplies by new qty and is shown in the same column of cost price. So its working gr8. But as in VBA code the undo option doesn't work. So in case if i want to undo the qty to 1, the cost price doesn't change to previous one. So is there any way to do this using the above code?
 

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,691
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Try:
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then

Target.Offset(, -1).Value = Target.Offset(, -1) * Target.Value
End If
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,125
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Orig As Long, Cur As Long
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then
      On Error GoTo Xit
      Application.EnableEvents = False
      Cur = Target.Value
      Application.Undo
      Orig = Target.Value
      If Orig = 0 Then Orig = 1
      Target = Cur
      Target.Offset(, -1).Value = Target.Offset(, -1) / Orig * Target
   End If
Xit:
   Application.EnableEvents = True
End Sub
 

Rosher

New Member
Joined
Mar 5, 2020
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then

Target.Offset(, -1).Value = Target.Offset(, -1) * Target.Value
End If
End Sub
Thanks for your help. I tried this code but its not working. Its working like before but if i change qty to 1 the cost price doesn't change, it remains the same. I want the cost price to be for 1 qty when i change qty to 1. How can i do this?
 

Rosher

New Member
Joined
Mar 5, 2020
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
How about
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Orig As Long, Cur As Long
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then
      On Error GoTo Xit
      Application.EnableEvents = False
      Cur = Target.Value
      Application.Undo
      Orig = Target.Value
      If Orig = 0 Then Orig = 1
      Target = Cur
      Target.Offset(, -1).Value = Target.Offset(, -1) / Orig * Target
   End If
Xit:
   Application.EnableEvents = True
End Sub
This is working gr8. Thanks for your quick response.
 

Watch MrExcel Video

Forum statistics

Threads
1,114,002
Messages
5,545,440
Members
410,684
Latest member
LakTik
Top