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:
Sort by date Sort by votes
mumps said:
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
Click to expand...
Hello Mumps
When deleting the part of the code that you indicate, the following 2 situations happen:
1. When entering a new product in COSTOS PRODUCTOS NACIONALES, it sends the information correctly to PRECIOS PRODUCTOS Y SERVICIOS but does NOT send the product name (column A) to PUNTO DE EQUILIBRIO.
2. When updating the purchase amount of an existing product in COSTOS PRODUCTOS NACIONALES, it correctly updates the product in PRECIOS PRODUCTOS Y SERVICIOS (unit cost column D) but sends back to PUNTO DE EQUILIBRIO the product name (column A) at the end of the column as if it were a new product (then there are 2 products with the same name, the one that was originally registered and the one that was sent again when updating the purchase amount of an existing product). The latter is what should not happen).
Thanks Mumps

Translated with DeepL.com (free version)
 
Upvote 0

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Try:
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")
    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
        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
    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
mumps said:
Try:
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")
    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
        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
    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
Click to expand...
Hello MUMPS, good morning.

I have done several tests with the new code you send me and it no longer duplicates the existing product when I modify a product in COSTOS PRODUCTOS NACIONALES. Great!!!!

The only detail that I found, and that before it did not do it, is that now when I register a new product in COSTOS PRODUCTOS NACIONALES, after executing the macro, the active sheet remains in PUNTO DE EQUILIBRIO and the correct thing is that it remains in PRECIOS PRODUCTOS Y SERVICIOS.

With this change I am fine, thank you very much MUMPS.



Translated with DeepL.com (free version)
 
Upvote 0
I am currently away on holidays and won’t be able to respond for a few weeks.
 
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
    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
        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
        Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Activate
    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
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,155
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