vba event handler in array

[roykana]

Dear All master,
I want if I make changes in the "master" sheet it automatically changes in the "trans" sheet.

I want a fast code because there are thousands of records in the "trans" sheet.

vba vlookup Change Event in array and dictionary .xlsm
	A	B	C	D	E	F	G	H	I	J
1	Supplier Name	CODE	NEW CODE	COMBINE	ITEM DESC	NEW PRICE	Isi	UNIT IN ACTUAL	Price	UNIT IN KONVERSI
2	STOCK OPNAME	BBK5801	04-00100101		AQUA1000	18,000	1	yard	20,000	mtr
3	STOCK OPNAME	BBK5802	04-00100101		AQUA200	18,001		yard	20,001	mtr
4	STOCK OPNAME	BBK5803	04-00100101		AQUA3	18,002		yard	20,002	mtr
5	STOCK OPNAME	BBK5804	04-00100101		AQUA4	18,003		yard	20,003	mtr
6	STOCK OPNAME	BBK5805	04-00100101		AQUA5	18,004		yard	20,004	mtr
7	STOCK OPNAME	BBK5806	04-00100101		AQUA6	18,004		yard	20,004	mtr
8	STOCK OPNAME	BBK5807	04-00100101		AQUA7	18,004		yard	20,004	mtr
9	STOCK OPNAME	BBK5808	04-00100101		AQUA8	18,004		yard	20,004	mtr
10	STOCK OPNAME	BBK5809	04-00100101		AQUA9	18,004		yard	20,004	mtr
11	STOCK OPNAME	BBK5810	04-00100101		AQUA10	18,004		yard	20,004	mtr
MASTER

Cell Formulas
Range	Formula
I2:I11	I2	=MASTER!$F$2:$F$11/0.9

vba vlookup Change Event in array and dictionary .xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1	KEY		COUNT	ADDRESS1	ADDRESS2	CITY	NOTE	RESULT	RECEIVE ITEM NO	SUPPLIER NAME	DATE IN	CODE	NEW CODE	ITEM DESC	QTY IN ACTUAL	UNIT IN ACTUAL	QTY IN KONVERSI	UNIT IN KONVERSI	NEW PRICE
2	0	ASTOCK OPNAME	1	GUDANG HOLIS	GUDANG HOLIS	Bandung	74	NOT SAME	1000	STOCK OPNAME	19/05/2016	BBK5801	0116002001	AQUA1000	74	yard	66.60	mtr	18,000
3	0	ASTOCK OPNAME	1	GUDANG HOLIS	GUDANG HOLIS	Bandung	74	NOT SAME	1002	STOCK OPNAME	20/05/2016	BBK5802	0116002001	AQUA200	74	yard	66.60	mtr	18,001
4	0	ASTOCK OPNAME	1	GUDANG HOLIS	GUDANG HOLIS	Bandung	74	NOT SAME	1002	STOCK OPNAME	20/05/2016	BBK5803	0116002001	AQUA3	50	yard	45.00	mtr	18,002
5	0	ASTOCK OPNAME	1	GUDANG HOLIS	GUDANG HOLIS	Bandung	74	NOT SAME	1002	STOCK OPNAME	20/05/2016	BBK5804	0116002001	AQUA4	50	yard	45.00	mtr	18,003
6	0	ASTOCK OPNAME	1	GUDANG HOLIS	GUDANG HOLIS	Bandung	74	NOT SAME	1002	STOCK OPNAME	20/05/2016	BBK5805	0116002001	AQUA5	50	yard	45.00	mtr	18,004
7	0	ASTOCK OPNAME	1	GUDANG HOLIS	GUDANG HOLIS	Bandung	74	NOT SAME	1002	STOCK OPNAME	20/05/2016	BBK5806	0116002001	AQUA6	50	yard	45.00	mtr	18,004
8	0	ASTOCK OPNAME	1	GUDANG HOLIS	GUDANG HOLIS	Bandung	74	NOT SAME	1002	STOCK OPNAME	20/05/2016	BBK5807	0116002001	AQUA7	50	yard	45.00	mtr	18,004
TRANS

Cell Formulas
Range	Formula
Q2:Q8	Q2	=O2*0.9

below is the vba event code in the "trans" sheet

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, c As Range, m, wsM As Worksheet, arr
    
    Set rng = Application.Intersect(Target, Me.Range("L:L"))
    If rng Is Nothing Then Exit Sub
    
    Set wsM = ThisWorkbook.Worksheets("MASTER")
    On Error GoTo bm_Safe_Exit
    Application.EnableEvents = False
    Application.ScreenUpdating = False            'improve performance...
    Application.Calculation = xlCalculationManual
    For Each c In rng.Cells    'process all changed cells in ColB
        v = c.Value
        If Len(v) > 0 Then
            m = Application.Match(c.Value, wsM.Range("B:B"), 0) 'match much faster than Find()
            If Not IsError(m) Then
                arr = wsM.Cells(m, "E").Resize(1, 6) 'one read
                c.Offset(0, 2).Value = arr(1, 1)
                c.Offset(0, 4).Value = arr(1, 4)
                c.Offset(0, 6).Resize(1, 2).Value = Array(arr(1, 6), arr(1, 2))
            End If
        Else
            c.EntireRow.Range("N1,P1,R1:S1").ClearContents 'clear cells if no code
        End If
    Next c

bm_Safe_Exit:
    Application.EnableEvents = True   'be sure to re-enable events
    Application.Calculation = xlCalculationAutomatic 'reset calculation
End Sub

 

[BSALV]

if i understand your code, by changing a L-cell, you want the N,P and R modified.
And quick.
If you change one cell at a time, there is not very much progress to make.

If you change +10 cells at once, then you can read L:Q as an array, do the modifications in that array and write in 3 steps the columns N, P and R. In that way, you only have 4 interactions, if the columns in between have no formulas even in 2 interactions.

Otherwise, in case of 2-10 changes, you can read wsM.Range("B:B") once in an array and use that array in your match-line

 

[roykana]

if i understand your code, by changing a L-cell, you want the N,P and R modified.
And quick.
If you change one cell at a time, there is not very much progress to make.

If you change +10 cells at once, then you can read L:Q as an array, do the modifications in that array and write in 3 steps the columns N, P and R. In that way, you only have 4 interactions.

Otherwise, in case of 2-10 changes, you can read wsM.Range("B:B") once in an array and use that array in your match-line

@BSALV
Dear Mr. BSALV
Thank you for your reply. i mean have to change event handler in sheet "trans" and also create event handler in sheet "master". Maybe you can help me?

tHANKS
ROYKANA

 

[BSALV]

you only need 1 handler in the "master", the changes in B, and update in "Trans" columns L, N, P and R.
No handler in the "trans".
As i reread your macro now, it's a little bit mixed, both ways, is it working now ?

 

[roykana]

you only need 1 handler in the "master", the changes in B, and update in "Trans" columns L, N, P and R.
No handler in the "trans".
As i reread your macro now, it's a little bit mixed, both ways, is it working now ?

@BSALV
actually my vba code is an event handler for the "trans" sheet which refers to changes in the n,p,r,s column if it wants to be changed for the better or faster.

As for the event handler in the "trans" sheet, it works accordingly

 

[BSALV]

the tables in master and trans are called "TBL_Master" and 'TBL_Trans"
The macro effects the whole table "TBL_Trans", so do this first in a auxiliary file, in case of errors and to know how quick it is.

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim LoT, LoM, cTcode, cMcode, ArrC, ArrM, ArrT

     t = Timer

     Set LoT = Sheets("trans").ListObjects("TBL_Trans")         'listobject in the "trans"
     Set cTcode = LoT.ListColumns("Code").DataBodyRange         'range ofr code in trans
     Set LoM = Sheets("Master").ListObjects("TBL_Master")       'listobject in "master"
     Set cMcode = LoM.ListColumns("code").DataBodyRange         'range for code in master
     ArrM = cMcode.Resize(, 9).Value                            'read 9 columns of importance in Master
     ArrC = Application.Transpose(Application.Index(ArrM, 0, 1))     '1 array to sarch in from the master
     ArrT = cTcode.Resize(, 8).Value                            'read 8 columns of importance in trans, and in this one, we make the changes

     If Intersect(Target, cTcode) Is Nothing Then Exit Sub

     For i = 1 To UBound(ArrT)                                  'loop through all the rows in Arrt
          r = Application.Match(ArrT(i, 1), ArrC, 0)            'find corresponding row in the master, column "Code"
          If Not IsNumeric(r) Then                              'not found = make these values empty
               ArrT(i, 3) = ""                                  'item desc
               ArrT(i, 5) = ""                                  'units in actual
               ArrT(i, 7) = ""                                  'units in konversi
               MsgBox ArrT(i, 1) & " not found"
          Else                                                  'found
               ArrT(i, 3) = ArrM(r, 4)                          'item desc
               ArrT(i, 5) = ArrM(r, 7)                          'units in actual
               ArrT(i, 7) = ArrM(r, 9)                          'units in konversi
          End If
     Next


     Application.EnableEvents = False
     cTcode.Resize(, 7).Value = ArrT                            'write the 7 columns back to trans (there are NO FORMULAS in these 7 columns !!!
     Application.EnableEvents = True

     MsgBox "done in " & Timer - t & " seconds for " & UBound(ArrT) & " rows"     ' the time to do so for that table in trans
    
End Sub

 

[roykana]

the tables in master and trans are called "TBL_Master" and 'TBL_Trans"
The macro effects the whole table "TBL_Trans", so do this first in a auxiliary file, in case of errors and to know how quick it is.

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim LoT, LoM, cTcode, cMcode, ArrC, ArrM, ArrT

     t = Timer

     Set LoT = Sheets("trans").ListObjects("TBL_Trans")         'listobject in the "trans"
     Set cTcode = LoT.ListColumns("Code").DataBodyRange         'range ofr code in trans
     Set LoM = Sheets("Master").ListObjects("TBL_Master")       'listobject in "master"
     Set cMcode = LoM.ListColumns("code").DataBodyRange         'range for code in master
     ArrM = cMcode.Resize(, 9).Value                            'read 9 columns of importance in Master
     ArrC = Application.Transpose(Application.Index(ArrM, 0, 1))     '1 array to sarch in from the master
     ArrT = cTcode.Resize(, 8).Value                            'read 8 columns of importance in trans, and in this one, we make the changes

     If Intersect(Target, cTcode) Is Nothing Then Exit Sub

     For i = 1 To UBound(ArrT)                                  'loop through all the rows in Arrt
          r = Application.Match(ArrT(i, 1), ArrC, 0)            'find corresponding row in the master, column "Code"
          If Not IsNumeric(r) Then                              'not found = make these values empty
               ArrT(i, 3) = ""                                  'item desc
               ArrT(i, 5) = ""                                  'units in actual
               ArrT(i, 7) = ""                                  'units in konversi
               MsgBox ArrT(i, 1) & " not found"
          Else                                                  'found
               ArrT(i, 3) = ArrM(r, 4)                          'item desc
               ArrT(i, 5) = ArrM(r, 7)                          'units in actual
               ArrT(i, 7) = ArrM(r, 9)                          'units in konversi
          End If
     Next


     Application.EnableEvents = False
     cTcode.Resize(, 7).Value = ArrT                            'write the 7 columns back to trans (there are NO FORMULAS in these 7 columns !!!
     Application.EnableEvents = True

     MsgBox "done in " & Timer - t & " seconds for " & UBound(ArrT) & " rows"     ' the time to do so for that table in trans
   
End Sub

@BSALV
dear Mr. BSALV,
Thanks for your reply. Sorry I'm late to reply to you.
I try to edit in the sheet "master" in the column "item desc" appears error as below and error in line code below
run-time error 6 overflow

ArrT = cTcode.Resize(, 8).Value                            'read 8 columns of importance in trans, and in this one, we make the changes

thanks
roykana