VBA - if copy paste

[ZimandGir]

Hi,

following request I had done before with the FormulaLocal(sverweis).

Now I want to learn more about if loops, but I cant get it done. So I ask you for help to show me how to do it.

Request - Reference worksheet uploaded:

check if value in blue marked column of worksheet "Bezugsdaten" matchs blue marked column of worksheet "Datenbank".
if matching then copy values of respective cell in green marked column (worksheet "bezugsdaten") to respective cell in yellow marked column (worksheet "Datenbank")
else msg "Data not found"

Important is, that it is dynamic, so no last cell in search range is defined - (.rows.count).End(x1lup)
Thats because there could be new data added in sheet "Bezugsdaten". It would be great if those new data (Name & Betrag) could be automatically added in next free row with respective values of worksheet "Datenbank".

Explanation:
I receive data I copy into worksheet Bezugsdaten. From there i want to add those specific "changing" data to the sheet "Datenbank", from where I construct accounting lines (that part I already did) and upload those files into the accounting system.

 

[ZimandGir]

EDIT
check if value in blue marked column of worksheet "Bezugsdaten" matchs blue marked column of worksheet "Datenbank".
if matching then copy values of respective cell in green marked column (worksheet "bezugsdaten") to respective cell in yellow marked columnS (worksheet "Datenbank")
else msg "Data not found"

 

[Alex Blakenburg]

See if this does what you are after.

Sub LookUpAndUpdate()

    Dim shtDaten As Worksheet, shtBezug As Worksheet
    Dim rngDaten As Range, rngBezug As Range
    Dim arrDaten As Variant, arrBezug As Variant
    Dim lrowDaten As Long, lrowBezug As Long
    Dim dictBezug As Object, dictKey As String
    Dim i As Long, cntMatch As Long, cntMiss As Long, outRow As Long
    
    Set shtDaten = Worksheets("Datenbank")
    Set shtBezug = Worksheets("Bezugsdaten")
    
    With shtDaten
        lrowDaten = .Cells(Rows.Count, "B").End(xlUp).Row
        Set rngDaten = .Range("A2:U" & lrowDaten)
        arrDaten = rngDaten
    End With

    With shtBezug
        lrowBezug = .Cells(Rows.Count, "A").End(xlUp).Row
        Set rngBezug = .Range("A4:B" & lrowBezug)
        arrBezug = rngBezug
    End With
    
    'load datenbank to dictionary
    Set dictBezug = CreateObject("Scripting.dictionary")
    For i = 1 To UBound(arrBezug)
        dictKey = arrBezug(i, 1)
        If Not dictBezug.exists(dictKey) Then
            dictBezug(dictKey) = i
        End If
    Next i
    
    ' Add a Column to array to identify "Matched"
    ReDim Preserve arrBezug(1 To UBound(arrBezug), 1 To 3)
    ' Get Daten values from Bezug Dictionary
    For i = 1 To UBound(arrDaten)
        dictKey = arrDaten(i, 2)
        If dictBezug.exists(dictKey) Then
            arrDaten(i, 5) = arrBezug(dictBezug(dictKey), 2)
            arrDaten(i, 20) = arrBezug(dictBezug(dictKey), 2)
            arrBezug(dictBezug(dictKey), 3) = "Matched"
            cntMatch = cntMatch + 1
        End If
    Next i

    ' Write back Daten updated data
    rngDaten.Columns(5).Value = Application.Index(arrDaten, 0, 5)
    rngDaten.Columns(20).Value = Application.Index(arrDaten, 0, 20)
    
    ' Add new rows
    cntMiss = UBound(arrBezug) - cntMatch
    If cntMiss > 0 Then
        ReDim arrDaten(1 To cntMiss, 1 To UBound(arrDaten, 2))
        For i = 1 To UBound(arrBezug)
            If arrBezug(i, 3) = "" Then
                outRow = outRow + 1
                arrDaten(outRow, 2) = arrBezug(i, 1)
                arrDaten(outRow, 5) = arrBezug(i, 2)
                arrDaten(outRow, 20) = arrBezug(i, 2)
            End If
        Next i
       ' write out new rows
       shtDaten.Range("A" & (lrowDaten + 1)).Resize(cntMiss, UBound(arrDaten, 2)).Value = arrDaten
        
    End If

End Sub