If you would like to post, please check out the MrExcel Message Board FAQ and register here. If you forgot your password, you can reset your password.

Updating data in cell, run the macro again and it should not happen.

Thread starter leobrice
Start date Jul 3, 2024

L

leobrice

New Member

Jul 3, 2024

#1

Greetings friends of MREXCEL, good evening.
The file is used to calculate costs of products, and the macros automate the process of calculations and procedures, however, has a detail.
I explain the operation:

SHEET NATIONAL PRODUCTS COSTS:
In it the information of national products is registered, in it is placed:
A= Product
B= NATIONAL
C= Unit of Measurement
D= Product Quantity
E= Total Purchase Amount
F and G= (formula) Unit Cost per Unit of Measurement
The Macro sends the product information (columns A and B) to the PRODUCTS AND SERVICES PRICES sheet when entering the Total Purchase Amount (E).

PRODUCTS AND SERVICES PRICE SHEET:
Here you record the product information to calculate the price.
The information of the products comes from the sheet NATIONAL PRODUCTS COSTS and they are:
A = Name of the Product
B= NATIONAL.
The rest of the sheet is handled by filling in information in some columns and the rest is formula.

There are 1 drawback with the macro of NATIONAL PRODUCTS COSTS and that is what I want to solve:
In the sheet NATIONAL PRODUCT COSTS, if I update the cost (COLUMN E) of some product already registered previously, it runs the macro again, sending the last registered product to PRODUCTS AND SERVICES PRICES. You should simply update it and it should also be updated in PRODUCTS AND SERVICES PRICES.

Translated with DeepL.com (free version)

CALCULADORA DE PRECIOS Y COSTOS DATCHEL PLUS1.xlsm

A

B

C

D

E

F

G

1

2

PRODUCT COST

3

PRODUCT

NACIONAL

MEASURE UNIT

QUANTITY

PURCHASE AMOUNT

UNIT PRODUCT COST

4

$

$

5

A

Kilo

410,00

125.000,00

6

B

Kilo

120,00

250.000,00

7

C

Kilo

65,00

320.000,00

8

D

Kilo

110,00

135.000,00

9

E

Kilo

80,00

85.000,00

10

F

Kilo

40,00

41.000,00

11

G

Kilo

75,00

54.000,00

12

H

Kilo

120,00

654.000,00

13

I

Kilo

60,00

126.000,00

14

J

Kilo

30,00

40.000,00

15

K

Kilo

85,00

65.000,00

16

L

Kilo

54,00

120.000,00

17

M

Kilo

14,00

15.000,00

18

19

20

COSTOS PRODUCTOS NACIONALES

Cell Formulas
Range	Formula
A1	A1	='INFORMACION GENERAL'!D5
F5:F20	F5	=IFERROR(E5/D5,0)
G5:G20	G5	=C5
B5:B20	B5	=$B$3

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
G5:G10000	Cell Value	=0	text	NO

Cells with Data Validation
Cell	Allow	Criteria
E5:E20	Any value
A5:B10000	Custom	=CONTAR.SI($A$5:$A$10000;A5)<=1
C5:C10000	List	=UNIDADES

CALCULADORA DE PRECIOS Y COSTOS DATCHEL PLUS1.xlsm

A

B

C

D

E

1

2

PRICES PRODUCTS

3

PRODUCT

PRODUCT NATIONAL

MEASURE UNIT

UNIT PRODUCT COST

SALES

4

OR

5

IMPORTED

$

6

A

NACIONAL

7

B

NACIONAL

8

C

NACIONAL

9

D

NACIONAL

10

E

NACIONAL

11

F

NACIONAL

12

F

NACIONAL

13

G

NACIONAL

14

H

NACIONAL

15

I

NACIONAL

16

J

NACIONAL

17

K

NACIONAL

18

L

NACIONAL

19

M

NACIONAL

20

21

PRECIOS PRODUCTOS Y SERVICIOS

Cell Formulas
Range	Formula
A1	A1	='INFORMACION GENERAL'!D5
E5	E5	=SUM(E6:E9998)
C6:C21	C6	=IFERROR(IF(B6="NACIONAL",VLOOKUP(A6,'COSTOS PRODUCTOS NACIONALES'!$A$5:$G$10000,3,0),VLOOKUP(A6,#REF!,3,0))," ")
D6:D21	D6	=IFERROR(IF(B6="NACIONAL",VLOOKUP(A6,'COSTOS PRODUCTOS NACIONALES'!$A$5:$G$10000,6,0),VLOOKUP(A6,#REF!,23,0))," ")

Cells with Data Validation
Cell	Allow	Criteria
A6:A18	Custom	=CONTAR.SI($A$5:$A$9998;A6)<=1

MACRO IN NATIONAL PRODUCTS COSTS

VBA Code:

Sub EnviarDatosCostosProductosNacionalesAPreciosProductosYServiciosA()
Application.ScreenUpdating = False

Dim ult, ult1 As Long
Dim rng As Range
ult2 = Sheets("COSTOS PRODUCTOS NACIONALES").Range("A" & Rows.Count).End(xlUp).Row
ult3 = Sheets("COSTOS PRODUCTOS NACIONALES").Range("B" & Rows.Count).End(xlUp).Row

ult = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("A" & Rows.Count).End(xlUp).Row + 1
ult1 = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("B" & Rows.Count).End(xlUp).Row + 1

Application.ScreenUpdating = False
Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("B" & ult1) = Sheets("COSTOS PRODUCTOS NACIONALES").Range("B" & ult3).Value
Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("A" & ult1) = Sheets("COSTOS PRODUCTOS NACIONALES").Range("A" & ult2).Value

Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Select

MsgBox ("SE HA ENVIADO AL MODULO PRECIOS PRODUCTOS Y SERVICIOS, LA INFORMACIÓN DE ESTE PRODUCTO O SERVICIO." & vbCr & Chr(13) & _
"POR FAVOR COMPLETE LA INFORMACIÓN SOLICITADA" & Chr(13) & _
"!OPERACIÓN REALIZADA SATISFACTORIAMENTE¡"), vbInformation, "CALCULADORA DE PRECIOS Y COSTOS DATCHEL PLUS"

Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("E" & ult1).Select

End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 4 Then
   If Target.Address Like "$E$*" Then
      If Range("E" & Target.Row) > 0 Then
         Application.ScreenUpdating = False
         Call EnviarDatosCostosProductosNacionalesAPreciosProductosYServiciosA
      End If
   End If
End If

Dim prod$, ufo&, ufd&
    Dim pro_d As Range
    Dim rDependents As Range
   
    uf = Range("C" & Rows.Count).End(xlUp).Row
    'prod = TempCombo
    prod = Range("A" & Target.Row).Value
   
    If Application.Intersect(Target, Range("C6:C" & uf)) Is Nothing And _
       Application.Intersect(Target, Range("D6:D" & uf)) Is Nothing And _
       Application.Intersect(Target, Range("E6:E" & uf)) Is Nothing Then
       Exit Sub
    End If
       
    If Worksheets("COSTOS PRODUCTOS NACIONALES").Range("F" & Target.Row).Value > 0 Then
        With Sheets("PRECIOS PRODUCTOS Y SERVICIOS")
            ufd = .Range("A" & Rows.Count).End(xlUp).Row
            Set pro_d = .Range("A6:A" & ufd).Find(prod)
            pro_d.Offset(, 1) = Worksheets("COSTOS PRODUCTOS NACIONALES").Range("B" & Target.Row).Value
        End With
    End If
End Sub

Last edited by a moderator: Jul 5, 2024

Sort by date Sort by votes

mumps

Well-known Member

Jul 7, 2024

#21

If you put the macro in PRECIOS PRODUCTOS Y SERVICIOS and enter a value in column A, that value will be sent to the bottom of column A in PUNTO DE EQUILIBRIO. This works. When you enter a new product in COSTOS PRODUCTOS NACIONALES, do you want to send it to both PRECIOS PRODUCTOS Y SERVICIOS and PUNTO DE EQUILIBRIO at the same time?

Upvote 0

Excel Facts

Waterfall charts in Excel?

Click here to reveal answer

Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

L

leobrice

New Member

Jul 11, 2024

#22

mumps said:
If you put the macro in PRECIOS PRODUCTOS Y SERVICIOS and enter a value in column A, that value will be sent to the bottom of column A in PUNTO DE EQUILIBRIO. This works. When you enter a new product in COSTOS PRODUCTOS NACIONALES, do you want to send it to both PRECIOS PRODUCTOS Y SERVICIOS and PUNTO DE EQUILIBRIO at the same time?

Hi mumps, good morning, it is a good option to send the value of column A at the same time.

Upvote 0

mumps

Well-known Member

Jul 11, 2024

#23

Replace the macro in the COSTOS PRODUCTOS NACIONALES sheet with this one:

VBA Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("E:E")) Is Nothing Or Target.Row < 5 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim prod As Range, desWS1 As Worksheet, desWS2 As Worksheet
    Set desWS1 = Sheets("PRECIOS PRODUCTOS Y SERVICIOS")
    Set desWS2 = Sheets("PUNTO DE EQUILIBRIO")
    Set prod = desWS1.Range("A:A").Find(Target.Offset(, -4), LookIn:=xlValues, lookat:=xlWhole)
    If Not prod Is Nothing Then
        With desWS1
            .Activate
            .Range("D" & prod.Row) = Target.Offset(, 1)
            .Range("E" & prod.Row).Select
        End With
    Else
        With desWS1
            .Activate
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(Target.Offset(, -4), Target.Offset(, -3), Target.Offset(, -2), Target.Offset(, 1))
            .Cells(.Rows.Count, "C").End(xlUp).Offset(, 2).Select
        End With
    End If
    With desWS2
        .Activate
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Target.Offset(, -4)
        .Cells(.Rows.Count, "A").End(xlUp).Offset(, 3).Select
    End With
    MsgBox ("SE HA ENVIADO AL MODULO PRECIOS PRODUCTOS Y SERVICIOS, LA INFORMACIÓN DE ESTE PRODUCTO O SERVICIO." & vbCr & Chr(13) & _
    "POR FAVOR COMPLETE LA INFORMACIÓN SOLICITADA" & Chr(13) & _
    "!OPERACIÓN REALIZADA SATISFACTORIAMENTE¡"), vbInformation, "CALCULADORA DE PRECIOS Y COSTOS DATCHEL PLU"
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Upvote 0

L

leobrice

New Member

Jul 12, 2024

#24

mumps said:

Replace the macro in the COSTOS PRODUCTOS NACIONALES sheet with this one:

VBA Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("E:E")) Is Nothing Or Target.Row < 5 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim prod As Range, desWS1 As Worksheet, desWS2 As Worksheet
    Set desWS1 = Sheets("PRECIOS PRODUCTOS Y SERVICIOS")
    Set desWS2 = Sheets("PUNTO DE EQUILIBRIO")
    Set prod = desWS1.Range("A:A").Find(Target.Offset(, -4), LookIn:=xlValues, lookat:=xlWhole)
    If Not prod Is Nothing Then
        With desWS1
            .Activate
            .Range("D" & prod.Row) = Target.Offset(, 1)
            .Range("E" & prod.Row).Select
        End With
    Else
        With desWS1
            .Activate
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(Target.Offset(, -4), Target.Offset(, -3), Target.Offset(, -2), Target.Offset(, 1))
            .Cells(.Rows.Count, "C").End(xlUp).Offset(, 2).Select
        End With
    End If
    With desWS2
        .Activate
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Target.Offset(, -4)
        .Cells(.Rows.Count, "A").End(xlUp).Offset(, 3).Select
    End With
    MsgBox ("SE HA ENVIADO AL MODULO PRECIOS PRODUCTOS Y SERVICIOS, LA INFORMACIÓN DE ESTE PRODUCTO O SERVICIO." & vbCr & Chr(13) & _
    "POR FAVOR COMPLETE LA INFORMACIÓN SOLICITADA" & Chr(13) & _
    "!OPERACIÓN REALIZADA SATISFACTORIAMENTE¡"), vbInformation, "CALCULADORA DE PRECIOS Y COSTOS DATCHEL PLU"
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Hi mumps good evening!

I was checking your macro and it does the routines in an excellent way, just as I wanted.

I was doing several tests, adding several products in COSTOS PRODUCTOS NACIONALES and it sends the information correctly to the other 2 sheets.

I only found 2 details that I think can be easily solved, and they are these:

1) After adding a product in COSTOS PRODUCTOS NACIONALES and sending the corresponding information to the other 2 sheets, the cursor remains on the PUNTO DE EQUILIBRIO sheet. The correct thing to do is to stay in PRECIOS PRODUCTOS Y SERVICIOS, and then add the corresponding information in that sheet.

2) After completing the whole macro process, I go to the sheet COSTOS PRODUCTOS NACIONALES to add a new product. I find that the cursor is usually on the next row below column E, which is where the macro is activated. It happened to me several times that I went to the sheet to enter a new product and started typing without realizing that the cursor was in column E and when I hit enter, the macro was activated. It would be convenient for the cursor to remain in column A, below the last product, ready to add a new one and complete the corresponding information in each column until it reaches column E.

With this, this post would be completely solved.

Then I will add another post, it is very similar to this, hopefully you can help me, Thank you in advance, Leo

Translated with DeepL.com (free version)

Upvote 0

mumps

Well-known Member

Jul 12, 2024

#25

Replace the current code in the COSTOS PRODUCTOS NACIONALES sheet with the code below.

VBA Code:

Private Sub Worksheet_Activate()
    Cells(Rows.Count, "A").End(xlUp).Offset(1).Select
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("E:E")) Is Nothing Or Target.Row < 5 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim prod As Range, desWS1 As Worksheet, desWS2 As Worksheet
    Set desWS1 = Sheets("PRECIOS PRODUCTOS Y SERVICIOS")
    Set desWS2 = Sheets("PUNTO DE EQUILIBRIO")
    With desWS2
        .Activate
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Target.Offset(, -4)
        .Cells(.Rows.Count, "A").End(xlUp).Offset(, 3).Select
    End With
    Set prod = desWS1.Range("A:A").Find(Target.Offset(, -4), LookIn:=xlValues, lookat:=xlWhole)
    If Not prod Is Nothing Then
        With desWS1
            .Activate
            .Range("D" & prod.Row) = Target.Offset(, 1)
            .Range("E" & prod.Row).Select
        End With
    Else
        With desWS1
            .Activate
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(Target.Offset(, -4), Target.Offset(, -3), Target.Offset(, -2), Target.Offset(, 1))
            .Cells(.Rows.Count, "C").End(xlUp).Offset(, 2).Select
        End With
    End If
    MsgBox ("SE HA ENVIADO AL MODULO PRECIOS PRODUCTOS Y SERVICIOS, LA INFORMACIÓN DE ESTE PRODUCTO O SERVICIO." & vbCr & Chr(13) & _
    "POR FAVOR COMPLETE LA INFORMACIÓN SOLICITADA" & Chr(13) & _
    "!OPERACIÓN REALIZADA SATISFACTORIAMENTE¡"), vbInformation, "CALCULADORA DE PRECIOS Y COSTOS DATCHEL PLU"
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Upvote 0

Solution

L

leobrice

New Member

Jul 12, 2024

#26

mumps said:

Replace the current code in the COSTOS PRODUCTOS NACIONALES sheet with the code below.

VBA Code:

Private Sub Worksheet_Activate()
    Cells(Rows.Count, "A").End(xlUp).Offset(1).Select
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("E:E")) Is Nothing Or Target.Row < 5 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim prod As Range, desWS1 As Worksheet, desWS2 As Worksheet
    Set desWS1 = Sheets("PRECIOS PRODUCTOS Y SERVICIOS")
    Set desWS2 = Sheets("PUNTO DE EQUILIBRIO")
    With desWS2
        .Activate
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Target.Offset(, -4)
        .Cells(.Rows.Count, "A").End(xlUp).Offset(, 3).Select
    End With
    Set prod = desWS1.Range("A:A").Find(Target.Offset(, -4), LookIn:=xlValues, lookat:=xlWhole)
    If Not prod Is Nothing Then
        With desWS1
            .Activate
            .Range("D" & prod.Row) = Target.Offset(, 1)
            .Range("E" & prod.Row).Select
        End With
    Else
        With desWS1
            .Activate
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(Target.Offset(, -4), Target.Offset(, -3), Target.Offset(, -2), Target.Offset(, 1))
            .Cells(.Rows.Count, "C").End(xlUp).Offset(, 2).Select
        End With
    End If
    MsgBox ("SE HA ENVIADO AL MODULO PRECIOS PRODUCTOS Y SERVICIOS, LA INFORMACIÓN DE ESTE PRODUCTO O SERVICIO." & vbCr & Chr(13) & _
    "POR FAVOR COMPLETE LA INFORMACIÓN SOLICITADA" & Chr(13) & _
    "!OPERACIÓN REALIZADA SATISFACTORIAMENTE¡"), vbInformation, "CALCULADORA DE PRECIOS Y COSTOS DATCHEL PLU"
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Excellent mumps, works fine. Very Thanks ¡¡¡¡¡

Upvote 0

mumps

Well-known Member

Jul 12, 2024

#27

My pleasure.

Upvote 0

L

leobrice

New Member

Jul 15, 2024

#28

mumps said:
My pleasure.

Hello mumps good afternoon!

I already uploaded the new post that I had told you, if you could help me I would appreciate it very much. As I told you, it is very similar to the previous case. It is called "Send cell values to 2 other sheets according to condition".
Thanks mumps¡¡¡

Upvote 0

L

leobrice

New Member

Aug 25, 2024

#29

mumps said:

Replace the current code in the COSTOS PRODUCTOS NACIONALES sheet with the code below.

VBA Code:

Private Sub Worksheet_Activate()
    Cells(Rows.Count, "A").End(xlUp).Offset(1).Select
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("E:E")) Is Nothing Or Target.Row < 5 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim prod As Range, desWS1 As Worksheet, desWS2 As Worksheet
    Set desWS1 = Sheets("PRECIOS PRODUCTOS Y SERVICIOS")
    Set desWS2 = Sheets("PUNTO DE EQUILIBRIO")
    With desWS2
        .Activate
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Target.Offset(, -4)
        .Cells(.Rows.Count, "A").End(xlUp).Offset(, 3).Select
    End With
    Set prod = desWS1.Range("A:A").Find(Target.Offset(, -4), LookIn:=xlValues, lookat:=xlWhole)
    If Not prod Is Nothing Then
        With desWS1
            .Activate
            .Range("D" & prod.Row) = Target.Offset(, 1)
            .Range("E" & prod.Row).Select
        End With
    Else
        With desWS1
            .Activate
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(Target.Offset(, -4), Target.Offset(, -3), Target.Offset(, -2), Target.Offset(, 1))
            .Cells(.Rows.Count, "C").End(xlUp).Offset(, 2).Select
        End With
    End If
    MsgBox ("SE HA ENVIADO AL MODULO PRECIOS PRODUCTOS Y SERVICIOS, LA INFORMACIÓN DE ESTE PRODUCTO O SERVICIO." & vbCr & Chr(13) & _
    "POR FAVOR COMPLETE LA INFORMACIÓN SOLICITADA" & Chr(13) & _
    "!OPERACIÓN REALIZADA SATISFACTORIAMENTE¡"), vbInformation, "CALCULADORA DE PRECIOS Y COSTOS DATCHEL PLU"
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Hello MUMPS good evening, how are you.

I tell you that the solution you gave me has worked very well, but I detected a process that I should not do. Let me explain.

When I modify the total amount of the purchase (column E) of a product already registered previously in the sheet COSTOS PRODUCTOS NACIONALES, the macro looks for the product in the sheet PRECIOS PRODUCTOS Y SERVICIOS and updates the unit cost of the product that was modified but sends the product again as new to the sheet PUNTO DE EQUILIBRIO (column A). Remember that in case of modification of the purchase amount in COSTOS PRODUCTOS NACIONALES, you should only update the unit cost of the product in the sheet PRECIOS PRODUCTOS Y SERVICIOS, you should not send the product as new to PUNTO DE EQUILIBRIO since it already exists.

Yesterday I noticed this situation because I had to make a modification of the purchase amount of a product and I noticed the above.

Can you help me to correct this detail.

Thank you

Upvote 0

mumps

Well-known Member

Aug 26, 2024

#30

Try deleting this part of the code:

VBA Code:

Set desWS2 = Sheets("PUNTO DE EQUILIBRIO")
With desWS2
    .Activate
    .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Target.Offset(, -4)
    .Cells(.Rows.Count, "A").End(xlUp).Offset(, 3).Select
End With

Upvote 0

You must log in or register to reply here.

Similar threads

L

Question

MACROS WORK WELL, BUT WHEN I DELETE THE DATA TO LEAVE THE FILE WITHOUT INFORMATION, MACROS DON'T WORK

Replies: 1

Views: 168

Jun 25, 2024

leobrice

L

L

Question

Send cell values to 2 other sheets according to condition

Replies: 2

Views: 164

Aug 7, 2024

leobrice

L

L

Solved

Send specific data from one sheet to another when a condition is met,

Replies: 7

Views: 206

Jun 22, 2024

mumps

L

Question

2 PROCESSES IN VBA MACROS THAT SHOULD NOT HAPPEN

Replies: 2

Views: 290

Jun 27, 2024

Rhodie72

K

Solved

Update to existing Move data macro

2

Replies: 11

Views: 680

Mar 21, 2024

Alex Blakenburg

A

Share:

Facebook X (Twitter) Reddit Pinterest Tumblr WhatsApp Email Link

Forum statistics

Threads: 1,220,965

Messages: 6,157,119

Members: 451,398

Latest member: rjsteward

Share this page

Facebook X (Twitter) Reddit Pinterest Tumblr WhatsApp Email Link

Top