Home > Software design >  When values in cells in two columns match values in the same columns in another sheet, then copy the
When values in cells in two columns match values in the same columns in another sheet, then copy the

Time:05-03

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

CodePudding user response:

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
  • Related