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

L

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:

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
Try this macro in the code module for sheet "COSTOS PRODUCTOS NACIONALES". The other macro is not needed.
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
    Dim prod As Range, desWS As Worksheet
    Set desWS = Sheets("PRECIOS PRODUCTOS Y SERVICIOS")
    Set prod = desWS.Range("A:A").Find(Target.Offset(, -4), LookIn:=xlValues, lookat:=xlWhole)
    If Not prod Is Nothing Then
        desWS.Range("D" & prod.Row) = Target.Offset(, 1)
    Else
        desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(Target.Offset(, -4), Target.Offset(, -3), Target.Offset(, -2), Target.Offset(, 1))
    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.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Try this macro in the code module for sheet "COSTOS PRODUCTOS NACIONALES". The other macro is not needed.
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
    Dim prod As Range, desWS As Worksheet
    Set desWS = Sheets("PRECIOS PRODUCTOS Y SERVICIOS")
    Set prod = desWS.Range("A:A").Find(Target.Offset(, -4), LookIn:=xlValues, lookat:=xlWhole)
    If Not prod Is Nothing Then
        desWS.Range("D" & prod.Row) = Target.Offset(, 1)
    Else
        desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(Target.Offset(, -4), Target.Offset(, -3), Target.Offset(, -2), Target.Offset(, 1))
    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.ScreenUpdating = True
End Sub
Click to expand...
Thanks Mumps, your macro does perfectly what I needed. Much appreciated!
It only has one detail and it is the following:
When registering a new product in the sheet COSTOS PRODUCTOS NACIONALES and after running the macro, which sends the product information to the sheet PRECIOS PRODUCTOS Y SERVICIOS, the cursor must remain in column E of the product that is being sent to enter the corresponding information manually in that column E.
As for updating the cost of an existing product, it works perfectly. It just updates the new value. It is fine.

Translated with DeepL.com (free version)
 
Upvote 0
Try:
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
    Dim prod As Range, desWS As Worksheet
    Set desWS = Sheets("PRECIOS PRODUCTOS Y SERVICIOS")
    Set prod = desWS.Range("A:A").Find(Target.Offset(, -4), LookIn:=xlValues, lookat:=xlWhole)
    If Not prod Is Nothing Then
        With desWS
            .Activate
            .Range("D" & prod.Row) = Target.Offset(, 1)
            .Range("E" & prod.Row).Select
        End With
    Else
        With desWS
            .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, "D").End(xlUp).Offset(, 1).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.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Try:
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
    Dim prod As Range, desWS As Worksheet
    Set desWS = Sheets("PRECIOS PRODUCTOS Y SERVICIOS")
    Set prod = desWS.Range("A:A").Find(Target.Offset(, -4), LookIn:=xlValues, lookat:=xlWhole)
    If Not prod Is Nothing Then
        With desWS
            .Activate
            .Range("D" & prod.Row) = Target.Offset(, 1)
            .Range("E" & prod.Row).Select
        End With
    Else
        With desWS
            .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, "D").End(xlUp).Offset(, 1).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.ScreenUpdating = True
End Sub
Click to expand...
Excellent mumps. Works very well. Thanks¡¡¡
 
Upvote 0
leobrice said:
Excellent mumps. Works very well. Thanks¡¡¡
Click to expand...
The marked solution has been changed accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.
 
Upvote 0
Hi mumps good afternoon.

You know the solution works perfectly, but it affected the execution of another macro that is related to the sheet PRECIOS PRODUCTOS Y SERVICIOS and a different sheet that was working fine.
What do you recommend, do I make a new post?
 
Upvote 0
I would have to see the other macro and also the other sheet.
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
MACROS WORK WELL, BUT WHEN I DELETE THE DATA TO LEAVE THE FILE WITHOUT INFORMATION, MACROS DON'T WORK
Replies
1
Views
207
leobrice
L
L
  • Question Question
Send cell values to 2 other sheets according to condition
Replies
2
Views
199
leobrice
L
L
  • Solved
Send specific data from one sheet to another when a condition is met,
Replies
7
Views
274
mumps
mumps
L
  • Question Question
Macro that copie a row and paste 500 rows
Replies
7
Views
129
leobrice
L
L
  • Question Question
2 PROCESSES IN VBA MACROS THAT SHOULD NOT HAPPEN
Replies
2
Views
339
Rhodie72
Rhodie72

Forum statistics

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

Share this page

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