Excel to return whole row when matching cells

Question

I have a workbook with 2 tables on 2 different sheets. I want all cells in column L (Sheet1) that matches cells in column A(Sheet2) to be displayed in a new list in Sheet3.

But I want to be able to see the entire ROW of the matching cells presented in Sheet2.

What I initialy did was a conditional formatting in order to see the duplicate in yellow, then I added this vba code to extract the matching cell, but I need the Entire row!

code:

Sub m()
Dim c As Range
For Each c In Sheets("Sheet1").Range("E2:E300")
    If c.DisplayFormat.Interior.Color = vbYellow Then
        Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = c.Value
    End If
Next c
End Sub

Any help is appreciated. Thank you

Answer 1

All you should need to do is add EntireRow to either side of the assignment

Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1).EntireRow.Value = c.EntireRow.Value

Answer 2

Copy Entire Rows of Matches in Column

• It will loop through Source Column to find a match in Lookup Column. If found, it will copy the entire row of the matching Lookup Cell to the Destination Worksheet.
• Run only the first procedure. It will call the rest when necessary.
• Adjust the values in the constants section.

Option Explicit

Sub copyMatches()
    
    ' Constants
    Const lName As String = "Sheet1"
    Const lFirst As String = "L2"
    Const sName As String = "Sheet2"
    Const sFirst As String = "A2"
    Const dName As String = "Sheet3"
    Const dCol As String = "A"
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Lookup
    Dim lrg As Range
    Set lrg = refNonEmptyColumn(wb.Worksheets(lName).Range(lFirst))
    If lrg Is Nothing Then Exit Sub
    Dim lData As Variant: lData = getColumn(lrg)
    
    ' Source
    Dim srg As Range
    Set srg = refNonEmptyColumn(wb.Worksheets(sName).Range(sFirst))
    If srg Is Nothing Then Exit Sub
    Dim sData As Variant: sData = getColumn(srg)
    
    ' Destination
    Dim dCell As Range
    Set dCell = refFirstEmptyCell(wb.Worksheets(dName).Columns(dCol))
    If dCell Is Nothing Then Exit Sub
            
    ' Combine
    Dim crg As Range
    Dim cIndex As Variant
    Dim r As Long
    For r = 1 To UBound(sData)
        cIndex = Application.Match(sData(r, 1), lData, 0)
        If IsNumeric(cIndex) Then
            Set crg = getCombinedRange(crg, srg.Cells(r))
        End If
    Next r
    
    ' Copy
    If Not crg Is Nothing Then
        crg.EntireRow.Copy dCell
    End If

End Sub

Function refNonEmptyColumn( _
    ByVal FirstCell As Range) _
As Range
    Const ProcName As String = "refNonEmptyColumn"
    On Error GoTo clearError
    
    If Not FirstCell Is Nothing Then
        With FirstCell.Cells(1)
            Dim lCell As Range
            Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
                .Find("*", , xlFormulas, , , xlPrevious)
            If Not lCell Is Nothing Then
                Set refNonEmptyColumn = .Resize(lCell.Row - .Row + 1)
            End If
        End With
    End If

ProcExit:
    Exit Function
clearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    Resume ProcExit
End Function

Function getColumn( _
    rg As Range, _
    Optional ByVal ColumnNumber As Long = 1, _
    Optional ByVal doTranspose As Boolean = False) _
As Variant
    Const ProcName As String = "getColumn"
    On Error GoTo clearError
    
    If Not rg Is Nothing Then
        If ColumnNumber > 0 And ColumnNumber <= rg.Columns.Count Then
            With rg.Columns(ColumnNumber)
                Dim rCount As Long: rCount = rg.Rows.Count
                Dim Result As Variant
                If rCount > 1 Then
                    If doTranspose Then
                        Dim Data As Variant: Data = .Value
                        ReDim Result(1 To 1, 1 To rCount)
                        Dim r As Long
                        For r = 1 To rCount
                            Result(1, r) = Data(r, 1)
                        Next r
                        getColumn = Result
                    Else
                        getColumn = .Value
                    End If
                Else
                    ReDim Result(1 To 1, 1 To 1): Result(1, 1) = .Value
                    getColumn = Result
                End If
            End With
        End If
    End If

ProcExit:
    Exit Function
clearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    Resume ProcExit
End Function

Function refFirstEmptyCell( _
    ByVal ColumnRange As Range) _
As Range
    Const ProcName As String = "refFirstEmptyCell"
    On Error GoTo clearError
    
    If Not ColumnRange Is Nothing Then
        With ColumnRange.Columns(1)
            Dim lCell As Range
            Set lCell = .Find("*", , xlFormulas, , , xlPrevious)
            If lCell Is Nothing Then
                Set refFirstEmptyCell = .Cells(1)
            Else
                Set refFirstEmptyCell = lCell.Offset(1)
            End If
       End With
    End If
    
ProcExit:
    Exit Function
clearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    Resume ProcExit
End Function

Function getCombinedRange( _
        ByVal BuiltRange As Range, _
        ByVal AddRange As Range)
    Const ProcName As String = "getCombinedRange"
    On Error GoTo clearError
    
    If AddRange Is Nothing Then
        If Not BuiltRange Is Nothing Then
            Set getCombinedRange = BuiltRange
        End If
    Else
        If BuiltRange Is Nothing Then
            Set getCombinedRange = AddRange
        Else
            If AddRange.Worksheet Is BuiltRange.Worksheet Then
                Set getCombinedRange = Union(BuiltRange, AddRange)
            End If
        End If
    End If

ProcExit:
    Exit Function
clearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    Resume ProcExit
End Function