Locate Change VBA (Intersection)

[pantakos]

Hello,

I have the following code that locates and copy cell value (if the cell is >0) from a sheet (AUDIO) to another sheet (PROFORMA DRYHIRE). What I want to do is,if a cell that is already copied to Proforma has beed changed (value), if the new value can be copied to proforma sheet (entire row or the cell value) by overwritten the previous one.
Can I use the Intersection to do that or there is another way?

I have tried various examples with Intersection but no luck

PRICE LIST 2021 FINAL.xlsm
	B	C	D	E	F	G	H	I	J	K
1
2								audio equipment - 1
3
4
5
6
7
8
9
10								TOTAL	0,00
11
12	R1 SPEAKERS	QTY	PRICE PER DAY	PCS		AMPLIFIERS	QTY	PRICE PER DAY	PCS
13	CLAIR BROS C12	16	€110,00		0	L-ACOUSTICS LA 48	70	€30,00		0
14	CLAIR BROS C8	16	€50,00		0	L-ACOUSTICS LA 24	17	€20,00		0
15	CLAIR BROS CS118	4	€50,00		0	L-ACOUSTICS LA 17	7	€15,00		0
16	L-ACOUSTICS V-DOSC	40	€80,00		0	L-ACOUSTICS LA 15	3	€20,00		0
17	L-ACOUSTICS dV-DOSC	114	€30,00		0	L-ACOUSTICS LA 12X	32	€100,00		0
18	L-ACOUSTICS KUDO	6	€60,00		0	L-ACOUSTICS LA 4X	8	€60,00		0
19	L-ACOUSTICS SYVA	SET L-R	€310,00		0	LAB GRUPPEN PLM 12K44	10	€100,00		0
20	L-ACOUSTICS ARCS WIDE	16	€40,00		0	LAB GRUPPEN FP 10000	10	€25,00		0
21	L-ACOUSTICS X15	24	€45,00		0	LAB GRUPPEN FP C68:4	6	€20,00		0
22	L-ACOUSTICS X12	24	€35,00		0	POWERSOFT K3	16	€25,00		0
23	L-ACOUSTICS X8	16	€30,00		0	POWERSOFR M50Q	16	€20,00		0
24	L-ACOUSTICS FM115	18	€25,00		0	YPSILON M1000	34	€10,00		0
25	L-ACOUSTICS XT-115	8	€25,00		0	YPSILON M2000	92	€15,00		0
26	L-ACOUSTICS XT-12	8	€20,00		0	YPSILON S1000	18	€15,00		0
27	L-ACOUSTICS MTD 108A	12	€20,00		0					0
28	L-ACOUSTICS KS 28	24	€80,00		0					0
29	L-ACOUSTICS dV-SUB	16	€25,00		0					0
30	L-ACOUSTICS SB18	16	€35,00		0					0
31	EAW SB 1000	50	€25,00		0	PROCESSORS	QTY	PRICE PER DAY	PCS
32	NEXO PS15	47	€20,00		0	DRIVERACK CLAIR -WLS-SMAART-LM44	1	€100,00		0
33	NEXO PS 10	12	€20,00		0	XTA DP 448	6	€50,00		0
34	ELECTROVOICE ELX112p	18	€20,00		0	XTA DP 226	16	€25,00		0
35	SLS LS 8800	72	€20,00		0	XTA DP 224	8	€20,00		0
36					0	LLC 115FM	14	€5,00		0
37					0	KLARK TEKNIK DN 8000	2	€25,00		0
38					0	NEXO TD PS 15	31	€5,00		0
39					0	NEXO TD PS 10	5	€5,00		0
40					0					0
41										0
42										0
43					0					0
44			TOTAL	€0,00				TOTAL	€0,00
AUDIO

Cell Formulas
Range	Formula
J10	J10	=SUM(E44,J44,E85,J85,E132,J132,E192,J198)
K32:K43,F43,F13:F40,K13:K30	K13	=I13*J13
E44,J44	E44	=SUM(F13:F43)

The sheet (AUDIO) is bigger , just post it for example

PROFORMA-DRYHIRE example

PRICE LIST 2021 FINAL.xlsm
	A	B	C	D
1
2		ΥΠΕΥΘΥΝΟΣ
3	ΠΡΟΣΦΟΡΑ / PRO-FORMA	ΠΕΛΑΤΗΣ
4	NO:	ΥΠΟΨΙΝ
5		ΔΙΕΥΘΥΝΣΗ
6		ΠΟΛΗ
7		ΑΦΜ
8		ΔOY
9		ΤΗΛ
10		email
11		ΠΑΡΑΓΩΓΗ
12		ΠΕΡΙΟΔΟΣ
13
14	ΤΥΠΟΣ - ΠΕΡΙΓΡΑΦΗ	ΤΕΜΑΧΙΑ	ΤΙΜΗ ΜΟΝΑΔΟΣ	ΣΥΝΟΛΟ
15				0,00 €
16				0,00 €
17				0,00 €
18				0,00 €
19				0,00 €
20				0,00 €
21				0,00 €
22				0,00 €
23				0,00 €
24				0,00 €
25				0,00 €
26				0,00 €
27				0,00 €
28				0,00 €
29				0,00 €
30				0,00 €
31				0,00 €
PROFORMA DRYHIRE

Cell Formulas
Range	Formula
D15:D31	D15	=B15*C15

Sub BuildInvoiceAudio()

    Dim ws
    Dim i As Long
    Dim cell As Range
    Dim Descript As String
    Dim PPD As Double
    Dim PCS As Long
    Dim nr As Long
    Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range, r6 As Range, r7 As Range, r8 As Range, r9 As Range, r10 As Range, r11 As Range, r12 As Range, r13 As Range, r14 As Range, myMultiAreaRange As Range
    
    Application.ScreenUpdating = False
   
'   ' Set array of worksheet names to copy from
    ws = Array("AUDIO")
   
    
'   Loop through all shees inthe array
    For i = LBound(ws) To UBound(ws)
        Set r1 = Sheets(ws(i)).Range("E13:E43")
        Set r2 = Sheets(ws(i)).Range("J13:J30")
        Set r3 = Sheets(ws(i)).Range("J32:J43")
        Set r4 = Sheets(ws(i)).Range("E57:E84")
        Set r5 = Sheets(ws(i)).Range("J57:J84")
        Set r6 = Sheets(ws(i)).Range("E100:E131")
        Set r7 = Sheets(ws(i)).Range("J100:J107")
        Set r8 = Sheets(ws(i)).Range("J109:J118")
        Set r9 = Sheets(ws(i)).Range("J120:J131")
        Set r10 = Sheets(ws(i)).Range("E146:E176")
        Set r11 = Sheets(ws(i)).Range("E178:E191")
        Set r12 = Sheets(ws(i)).Range("J146:J176")
        Set r13 = Sheets(ws(i)).Range("J178:J184")
        Set r14 = Sheets(ws(i)).Range("J186:J197")
                        
        Set myMultiAreaRange = Union(r1, r2, r3, r4, r5, r6, r7, r8, r9, r10, r11, r12, r13, r14)
        
'       Iterate through column D on each sheet looking for pieces
        For Each cell In myMultiAreaRange
        
'           See if anything entered in pieces
            If cell > 0 Then
                Descript = cell.Offset(0, -3)  'get description from column B
                PPD = cell.Offset(0, -1) 'get price p/d from column D
                PCS = cell  'get pieces from column E
'               Find next available row in column A on Invoice sheet
                nr = Sheets("PROFORMA DRYHIRE").Cells(Rows.Count, "A").End(xlUp).Row + 1
                If nr < 15 Then nr = 15
'               Populate values on Invoice sheet
                Sheets("PROFORMA DRYHIRE").Cells(nr, "A") = Descript
                Sheets("PROFORMA DRYHIRE").Cells(nr, "B") = PCS
                Sheets("PROFORMA DRYHIRE").Cells(nr, "C") = PPD
            End If
        Next cell
    Next i
   
    Application.ScreenUpdating = False

End Sub

Thank you in advance!

 

[DanteAmor]

After this line:
nr = 14

Add this line:
Sheets("PROFORMA DRYHIRE").Range("A15:C70").ClearContents

 

[pantakos]

After this line:
nr = 14

Add this line:
Sheets("PROFORMA DRYHIRE").Range("A15:C70").ClearContents

I really dont know what to say!
Thank you so much !