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

L

leobrice

New Member

Jul 5, 2024

#11

CALCULADORA DE PRECIOS Y COSTOS DATCHEL PLUS1.xlsm

A

B

C

D

E

1

Piscinas Aqualux S.A. DEFINITIVA

2

PRECIO DE VENTA DE PRODUCTOS Y SERVICIOS

3

PRODUCTO / SERVICIO

PRODUCTO NACIONAL

UNIDAD DE MEDIDA

COSTO UNITARIO PRODUCTO

VENTAS ESTIMADAS MENSUALES UNIDADES

4

O

5

IMPORTADO

U$

6

IMPORTADO

IMPORTADO

7

S1

NACIONAL

1.00

8

52,000.00

9

A

NACIONAL

Litro

1,875.00

10

B

NACIONAL

Kilo

11,555.56

11

COSTOS DE SERVICIOS

NACIONAL

Servicio

48,656.94

124.00

12

C

NACIONAL

Galón

10,000.00

10,000.00

13

D

NACIONAL

Litro

1,635.00

14

15

PRECIOS PRODUCTOS Y SERVICIOS

Cell Formulas
Range	Formula
A1	A1	='INFORMACION GENERAL'!D5
D5	D5	=MONEDAS!C2
E5	E5	=SUM(E6:E9998)
C14:C15,C6:C8	C6	=IFERROR(IF(B6="NACIONAL",VLOOKUP(A6,'COSTOS PRODUCTOS NACIONALES'!$A$5:$G$10000,3,0),VLOOKUP(A6,'COSTOS PRODUCTOS IMPORTADOS'!$A$5:$X$10000,3,0))," ")

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

CALCULADORA DE PRECIOS Y COSTOS DATCHEL PLUS1.xlsm

A

B

C

D

1

Piscinas Aqualux S.A. DEFINITIVA

2

PUNTO DE EQUILIBRIO GLOBAL MENSUAL

3

INFORME MENSUAL

VENTAS MENSUALES ESTIMADAS Y/O REALES

VENTA PROYECTADA MENSUAL

PRECIO DE VENTA

4

MES: SEPTIEMBRE 2021

UNIDADES

UNIDADES

U$

5

PRODUCTOS Y SERVICIOS TOTALES →

6

S1

10

7

S2

14

8

IMPORTADO

IMPORTADO

9

10

A

A

11

B

B

12

COSTOS DE SERVICIOS

COSTOS DE SERVICIOS

COSTOS DE SERVICIOS

13

C

C

14

D

D

15

16

17

18

PUNTO DE EQUILIBRIO

Cell Formulas
Range	Formula
A1	A1	='INFORMACION GENERAL'!D5
A2	A2	=IF('COSTOS FIJOS'!A5="MENSUAL","PUNTO DE EQUILIBRIO GLOBAL MENSUAL","PUNTO DE EQUILIBRIO GLOBAL ANUAL")
A3	A3	=IF('COSTOS FIJOS'!A5="MENSUAL","INFORME MENSUAL","INFORME ANUAL")
C3	C3	=IF('COSTOS FIJOS'!A5="MENSUAL","VENTA PROYECTADA MENSUAL","VENTA PROYECTADA ANUAL")
D4	D4	=MONEDAS!C2
B5:D5	B5	=SUM(B6:B10000)
C10:C18,C6:C8	C6	=IF('COSTOS FIJOS'!$A$5="MENSUAL",B6,B6*12)
D10:D18,D6:D8	D6	=IFERROR(VLOOKUP(A6,'PRECIOS PRODUCTOS Y SERVICIOS'!$A$6:$W$10000,21,0),0)

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

Remember that from COSTOS PRODUCTOS NACIONALES the product (column A) is sent to PRECIOS PRODUCTOS Y SERVICIOS and the PRECIOS PRODUCTOS Y SERVICIOS macro sends the product (column A) to PUNTO DE EQUILIBRIO (columna A) and that's it.

Now the macro PRECIOS PRODUCTOS Y SERVICIOS sends the product (column A) to PUNTO DE EQUILIBRIO to columns A and B.

MACRO IN PRECIOS PRODUCTOS Y SERVICIOS:

VBA Code:

Sub EnviarDatosPreciosProductosYServiciosAPuntoDeEquilibrio()

Dim ult As Long
Dim rng As Range
ult1 = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("A" & Rows.Count).End(xlUp).Row

ult = Sheets("PUNTO DE EQUILIBRIO").Range("A" & Rows.Count).End(xlUp).Row + 1

Sheets("PUNTO DE EQUILIBRIO").Range("A" & ult) = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("A" & ult1).Value

Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Select

'MsgBox (" SE HA ENVIADO AL MODULO COSTOS FIJOS LA INFORMACIÓN DE ESTE TRABAJADOR DE SUELDOS Y SALARIOS" & Chr(13) & _
"POR FAVOR COMPLETE LA INFORMACIÓN DE ESTE TRABAJADOR" & Chr(13) & _
"OPERACIÓN REALIZADA SATISFACTORIAMENTE"), vbInformation, "CALCULADORA DE RECETAS DATCHEL PRO"

'Sheets("PUNTO DE EQUILIBRIO").Range("D" & ult1).Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 5 Then
   If Target.Address Like "$A$*" Then
      If Range("A" & Target.Row) <> 0 Then
         Call EnviarDatosPreciosProductosYServiciosAPuntoDeEquilibrio
      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("B9:B" & uf)) Is Nothing And _
       Application.Intersect(Target, Range("C9:C" & uf)) Is Nothing And _
       Application.Intersect(Target, Range("D9:D" & uf)) Is Nothing And _
       Application.Intersect(Target, Range("E9:E" & uf)) Is Nothing And _
       Application.Intersect(Target, Range("F9:F" & uf)) Is Nothing And _
       Application.Intersect(Target, Range("G9:G" & uf)) Is Nothing And _
       Application.Intersect(Target, Range("H9:H" & uf)) Is Nothing Then
       Exit Sub
    End If
       
    If Worksheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("A" & Target.Row).Value > 0 Then
        With Sheets("PUNTO DE EQUILIBRIO")
            ufd = .Range("A" & Rows.Count).End(xlUp).Row
            Set pro_d = .Range("A8:A" & ufd).Find(prod)
            pro_d.Offset(, 1) = Worksheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("A" & Target.Row).Value
        End With
    End If

Last edited by a moderator: Jul 5, 2024

Upvote 0

Excel Facts

Who is Mr Spreadsheet?

Click here to reveal answer

Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

mumps

Well-known Member

Jul 6, 2024

#12

The macro you posted is very confusing. Do you want the macro in PRECIOS PRODUCTOS Y SERVICIOS to work exactly the same way as the macro in COSTOS PRODUCTOS NACIONALES except that the product is copied to columns A and B of PUNTO DE EQUILIBRIO instead of just column A? Also, do you want to replace existing values in PUNTO DE EQUILIBRIO and place new values at the bottom of PUNTO DE EQUILIBRIO? Please clarify in detail.

Upvote 0

L

leobrice

New Member

Jul 6, 2024

#13

mumps said:
The macro you posted is very confusing. Do you want the macro in PRECIOS PRODUCTOS Y SERVICIOS to work exactly the same way as the macro in COSTOS PRODUCTOS NACIONALES except that the product is copied to columns A and B of PUNTO DE EQUILIBRIO instead of just column A? Also, do you want to replace existing values in PUNTO DE EQUILIBRIO and place new values at the bottom of PUNTO DE EQUILIBRIO? Please clarify in detail.

Hello mumps good morning!
I comment you:

To the PUNTO DE EQUILIBRIO sheet, only the product name of PRECIOS PRODUCTOS Y SERVICIOS (column A) must arrive, the information that goes in column B, is registered manually and the rest of the columns are formulas. In this case, it is not necessary to replace data.

Thanks mumps¡¡¡

Translated with DeepL.com (free version)

Upvote 0

mumps

Well-known Member

Jul 6, 2024

#14

Try:

VBA Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Intersect(Target, Range("A:A")) Is Nothing Or Target.Row < 6 Then Exit Sub
    If Range("A" & Target.Row) <> 0 Then
        With Sheets("PUNTO DE EQUILIBRIO")
            .Activate
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Cells(Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Rows.Count, "A").End(xlUp)
            .Cells(.Rows.Count, "A").End(xlUp).Offset(, 3).Select
        End With
        MsgBox (" SE HA ENVIADO AL MODULO COSTOS FIJOS LA INFORMACIÓN DE ESTE TRABAJADOR DE SUELDOS Y SALARIOS" & Chr(13) & _
        "POR FAVOR COMPLETE LA INFORMACIÓN DE ESTE TRABAJADOR" & Chr(13) & _
        "OPERACIÓN REALIZADA SATISFACTORIAMENTE"), vbInformation, "CALCULADORA DE RECETAS DATCHEL PRO"
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Upvote 0

L

leobrice

New Member

Jul 6, 2024

#15

mumps said:

Try:

VBA Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Intersect(Target, Range("A:A")) Is Nothing Or Target.Row < 6 Then Exit Sub
    If Range("A" & Target.Row) <> 0 Then
        With Sheets("PUNTO DE EQUILIBRIO")
            .Activate
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Cells(Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Rows.Count, "A").End(xlUp)
            .Cells(.Rows.Count, "A").End(xlUp).Offset(, 3).Select
        End With
        MsgBox (" SE HA ENVIADO AL MODULO COSTOS FIJOS LA INFORMACIÓN DE ESTE TRABAJADOR DE SUELDOS Y SALARIOS" & Chr(13) & _
        "POR FAVOR COMPLETE LA INFORMACIÓN DE ESTE TRABAJADOR" & Chr(13) & _
        "OPERACIÓN REALIZADA SATISFACTORIAMENTE"), vbInformation, "CALCULADORA DE RECETAS DATCHEL PRO"
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

No, it does nothing mumps.
I started from COSTO DE PRODUCTOS NACIONALES adding a product, it sends it to PRECIOS PRODUCTOS Y SERVICIOS and the process stops there, it does not send the product to the column A of PUNTO DE EQUILIBRIO..

Upvote 0

mumps

Well-known Member

Jul 6, 2024

#16

Did you put the macro in the PUNTO worksheet code module?

Upvote 0

L

leobrice

New Member

Jul 6, 2024

#17

mumps said:
Did you put the macro in the PUNTO worksheet code module?

Ups, No, in PRECIOS, Let me try

Upvote 0

L

leobrice

New Member

Jul 6, 2024

#18

mumps said:
Did you put the macro in the PUNTO worksheet code module?

No mumps, It does nothing

Upvote 0

mumps

Well-known Member

Jul 6, 2024

#19

I’ll have another look at it tomorrow.

Upvote 0

L

leobrice

New Member

Jul 6, 2024

#20

mumps said:
I’ll have another look at it tomorrow.

I wrote the product in column A of PUNTO DE EQUILIBRIO, and the next product was updated, but it should not work like that. Let me explain:

When I create a new product in COSTOS PRODUCTOS NACIONALES, from here it sends it to PRECIOS PRODUCTOS Y SERVICIOS and from here it then goes to PUNTO DE EQUILIBRIO.
I think the macro should be in PRECIOS PRODUCTOS Y SERVICIOS. This sheet also gets information from another sheet called COSTOS PRODUCTOS INTERNACIONALES which then sends the product to PUNTO DE EQUILIBRIO as well.

ok, mumps have a good night..

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