Excel VBA, How to Copy the cell/cells from sheet1 to the sheet2 with condition

Question

I have two sheets, invoice and customer. On the invoice sheet, when I write the customer's name in cell A11, the rest of the customer's information comes up in A12 till A15. However, I want to change this information from the invoice sheet and copy it on the customer sheet. My code works for a customer. But I need this code for every customer. I need your idea, please

    Private Sub Worksheet_Change(ByVal Target As Range)

    Set sh1 = ThisWorkbook.Sheets("Customer")
    Set sh4 = ThisWorkbook.Sheets("Invoice")
    
    If Not Intersect(Target, sh4.Range("A12:A15")) Is Nothing Then
        If sh4.Range("A11").Value = sh1.Range("B2").Value Then
            sh1.Range("F2").Value = sh4.Range("A12").Value
            sh1.Range("G2").Value = sh4.Range("A13").Value
        End If
    End If
    
   End Sub

Answer 1

You can achieve this kind of "change if match" with dictionaries.

Option Explicit

    Sub DictMatch()
        Dim dict As Object, sh1 As Worksheet, sh4 As Worksheet 'you should declare your vars
        Set dict = CreateObject("Scripting.Dictionary") 'create dictionary lateB
        Set sh1 = ThisWorkbook.Sheets("Customer") 'adds no value, you could just use Sheet1
        Set sh4 = ThisWorkbook.Sheets("Invoice") 'adds no value, you could just use Sheet4
        
        Dim arr, arr2, LastRowSh1 As Long, LastRowSh4 As Long
        LastRowSh1 = sh1.Cells(sh4.Rows.Count, "B").End(xlUp).Row 'count rows from last row
        LastRowSh4 = sh4.Cells(sh4.Rows.Count, "A").End(xlUp).Row 'count rows from last row
         
        arr = sh4.Range(sh4.Cells(1, 1), sh4.Cells(LastRowSh4, 1)).Value2 'load col A of invoices
        arr2 = sh1.Range(sh1.Cells(1, 2), sh1.Cells(LastRowSh1, 7)).Value2 'load col B to G of cust
        
        Dim j As Long
        With dict 'used because I'm to lazy to retype dict everywhere :)
            .CompareMode = 1 'textcompare
            For j = 1 To UBound(arr) 'traverse invoices
                If Not .Exists(arr(j, 1)) Then 'set key if I don't have it yet in dict
                    .Add Key:=arr(j, 1), Item:=j
                End If
            Next j
            
            For j = 1 To UBound(arr2) 'traverse customers
                If .Exists(arr2(j, 1)) Then 'matching happens here, compare data from target with dictionary
                    arr2(j, 5) = arr(dict(arr2(j, 1)) + 1, 1) 'write to target array if match
                    arr2(j, 6) = arr(dict(arr2(j, 1)) + 2, 1) 'we could make this more dynamic if you have more rows
                End If
            Next j
        End With
        With sh1
            .Range(.Cells(1, 2), .Cells(LastRowSh1, 7)) = arr2 'dump updated array to customer sheet
        End With
    End Sub

Based on your input it should do what you want without changes but if you encounter any issue let me know. if not, accept as "Answer".

Some thoughts:

• It's best practice to add "option explicit" to the top your code, this will force you to declare all vars which will save you a lot of headaches one day :).
• Although you can paste this code in your intersect, I would recommend to add it to the "save" event (or a button). Otherwise the full code will run every time you edit a field without any additional value.