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

leobrice

New Member
Joined
Jun 14, 2024
Messages
37
Office Version
  1. 2013
Platform
  1. Windows
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
ABCDEFG
1ABC Ltda
2PRODUCT COST
3PRODUCTNACIONALMEASURE UNITQUANTITYPURCHASE AMOUNTUNIT PRODUCT COST
4$$
5ANACIONALKilo410,00125.000,00304,88por Kilo
6BNACIONALKilo120,00250.000,002.083,33por Kilo
7C NACIONALKilo65,00320.000,004.923,08por Kilo
8DNACIONALKilo110,00135.000,001.227,27por Kilo
9ENACIONALKilo80,0085.000,001.062,50por Kilo
10FNACIONALKilo40,0041.000,001.025,00por Kilo
11GNACIONALKilo75,0054.000,00720,00por Kilo
12HNACIONALKilo120,00654.000,005.450,00por Kilo
13INACIONALKilo60,00126.000,002.100,00por Kilo
14JNACIONALKilo30,0040.000,001.333,33por Kilo
15KNACIONALKilo85,0065.000,00764,71por Kilo
16LNACIONALKilo54,00120.000,002.222,22por Kilo
17MNACIONALKilo14,0015.000,001.071,43por Kilo
18NACIONAL0,000
19NACIONAL0,000
20NACIONAL0,000
COSTOS PRODUCTOS NACIONALES
Cell Formulas
RangeFormula
A1A1='INFORMACION GENERAL'!D5
F5:F20F5=IFERROR(E5/D5,0)
G5:G20G5=C5
B5:B20B5=$B$3
Cells with Conditional Formatting
CellConditionCell FormatStop If True
G5:G10000Cell Value=0textNO
Cells with Data Validation
CellAllowCriteria
E5:E20Any value
A5:B10000Custom=CONTAR.SI($A$5:$A$10000;A5)<=1
C5:C10000List=UNIDADES


CALCULADORA DE PRECIOS Y COSTOS DATCHEL PLUS1.xlsm
ABCDE
1ABC Ltda
2PRICES PRODUCTS
3PRODUCTPRODUCT NATIONALMEASURE UNITUNIT PRODUCT COSTSALES
4OR
5IMPORTED$0
6ANACIONALKilo304,88
7BNACIONALKilo2.083,33
8C NACIONALKilo4.923,08
9DNACIONALKilo1.227,27
10ENACIONALKilo1.062,50
11FNACIONALKilo1.025,00
12FNACIONALKilo1.025,00
13GNACIONALKilo720,00
14HNACIONALKilo5.450,00
15INACIONALKilo2.100,00
16JNACIONALKilo1.333,33
17KNACIONALKilo764,71
18LNACIONALKilo2.222,22
19MNACIONALKilo1.071,43
20
21
PRECIOS PRODUCTOS Y SERVICIOS
Cell Formulas
RangeFormula
A1A1='INFORMACION GENERAL'!D5
E5E5=SUM(E6:E9998)
C6:C21C6=IFERROR(IF(B6="NACIONAL",VLOOKUP(A6,'COSTOS PRODUCTOS NACIONALES'!$A$5:$G$10000,3,0),VLOOKUP(A6,#REF!,3,0))," ")
D6:D21D6=IFERROR(IF(B6="NACIONAL",VLOOKUP(A6,'COSTOS PRODUCTOS NACIONALES'!$A$5:$G$10000,6,0),VLOOKUP(A6,#REF!,23,0))," ")
Cells with Data Validation
CellAllowCriteria
A6:A18Custom=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:
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

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
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
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
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
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
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
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
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
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

Forum statistics

Threads
1,223,880
Messages
6,175,154
Members
452,615
Latest member
bogeys2birdies

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