When values in cells in two columns match values in the same columns in another sheet, then copy the whole row

user_18971950 0
Viewed 41
Option Explicit

Sub test()
 
  Dim rg As Range
  Dim name As String
  Dim name2 As String
  Dim wsh1 As Worksheet, wsh2 As Worksheet
  Dim i As Long

 
  Set wsh1 = ThisWorkbook.Worksheets("Database")
  Set wsh2 = ThisWorkbook.Worksheets("Løbs-skabelon")
  
  On Error GoTo 0

  Application.ScreenUpdating = False
  
  name = wsh2.Range("a" & Rows.Count).End(xlUp).Value
  name2 = wsh2.Range("e" & Rows.Count).End(xlUp).Value

  For i = 1 To wsh1.Range("a" & Rows.Count).End(xlUp).Row
    
  If wsh1.Cells(i, 1) = name And wsh1.Cells(i, 5) = name2 Then

  wsh1.Range(wsh1.Cells(i, 1), wsh1.Cells(i, 9)).Copy
  
 wsh2.Range("a" & Rows.Count).End(xlUp).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
     
 End If

 Next i
 
Application.ScreenUpdating = True

Worksheets("Løbs-skabelon").Range("a3").Select

Exit Sub

End Sub

I have two sheets. One is a database containing all information in rows from columns A to I. In the other sheet, I have the same structure in columns but only info in column A and E which will give a unique combination of only matching one row in database.

So ONLY when the cell in column A and E match a row in the database, I want the full row from the database copied into this row. My vba so far only copies one row/last row...

worksheet database

vba excel
1 Answers

Update Worksheet Rows

Option Explicit

Sub UpdateWorksheetRows()
 
    Const sName As String = "Database"
    Const sfRow As Long = 5
    
    Const dName As String = "Lobs-skabelon"
    Const dfRow As Long = 5
    
    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets(sName)
    Dim slRow As Long: slRow = sws.Range("A" & sws.Rows.Count).End(xlUp).Row
    Dim srCount As Long: srCount = slRow - sfRow + 1
    Dim srg1 As Range: Set srg1 = sws.Range("A5").Resize(srCount)
    Dim srg2 As Range: Set srg2 = sws.Range("E5").Resize(srCount)
    
    Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets(dName)
    Dim dlRow As Long: dlRow = dws.Range("A" & dws.Rows.Count).End(xlUp).Row
    Dim drCount As Long: drCount = dlRow - dfRow + 1
    
    Application.ScreenUpdating = False
    
    Dim sIndex As Variant
    Dim r As Long
     
    For r = dfRow To dlRow
        sIndex = dws.Evaluate("MATCH(1,('" & sName & "'!" & srg1.Address & "=" _
            & dws.Range("A" & r).Address & ")*('" & sName & "'!" _
            & srg2.Address & "=" & dws.Range("E" & r).Address & "),0)")
        If IsNumeric(sIndex) Then
            'Debug.Print r, sIndex
            dws.Rows(r).Columns("A:I").Value _
                = srg1.Cells(sIndex).EntireRow.Columns("A:I").Value
        End If
    Next r
    
    Worksheets("Lobs-skabelon").Range("A3").Select

    Application.ScreenUpdating = True
    
    MsgBox "Worksheet rows updated.", vbInformation

End Sub
user_98140690
Related