Copy entire row if letter “R” is entered in the row.

[Boboka]

Hi everyone,

I tried to search on the internet but can’t find a solution. I am listing employees out from the same department using vlookup.

In the end 10 rows of employees data are shown from Column A : G. I want to copy that row of data if I type a letter “R” in column H. Column A is hardcoded numeric 1,2,3 etc. where column B : G is vlookup formula data.

This row of data will then appear in a new sheet call Leader in 1st row.
So when I vlookup another department, maybe another 8 row of employee data are shown. So when I type a letter “R”, in colum H, one of the employee row. It will copy that row in Sheet Leader under 2nd row. I found this code in the internet and try to edit.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsh As Worksheet
    Dim rng As Range
    If Not Intersect(Range("H10:H" & Rows.Count), Target) Is Nothing Then
        Set wsh = Worksheets("NonConformitySchedule")
        For Each rng In Intersect(Range("H10:H" & Rows.Count), Target)
            Select Case rng.Value
                Case "R"
                    rng.EntireRow.Copy Destination:=wsh.Range("A" & rng.Row)
                Case Else
                    ' Do nothing
            End Select
        Next rng
        Application.CutCopyMode = False
    End If
End Sub

This can’t work as it can’t paste a vlookup formula data into sheets Leader. It only copy hardcode numeric no. If I type a “R” on row 10 employee, it only show 10. But the column B to G is blank. And it appear in sheet Leader A10 cell “10”.

Thank you in advance..

 

[rollis13]

If I correctly understood, have a try with my macro to be pasted in the sheet's module:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsh    As Worksheet
    Dim LR     As Long
    If Not Intersect(Range("H10:H" & Range("H" & Rows.Count).End(xlUp).Row), Target) Is Nothing Then
        Set wsh = Worksheets("Leader")
        LR = wsh.Cells(Rows.Count, 1).End(xlUp).Offset(Abs(wsh.Cells(Rows.Count, 1).End(xlUp).Value <> ""), 0).Row
        If UCase(Target) = "R" Then Cells(Target.Row, 1).EntireRow.Copy
        wsh.Range("A" & LR).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
End Sub

 

[Boboka]

If I correctly understood, have a try with my macro to be pasted in the sheet's module:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsh    As Worksheet
    Dim LR     As Long
    If Not Intersect(Range("H10:H" & Range("H" & Rows.Count).End(xlUp).Row), Target) Is Nothing Then
        Set wsh = Worksheets("Leader")
        LR = wsh.Cells(Rows.Count, 1).End(xlUp).Offset(Abs(wsh.Cells(Rows.Count, 1).End(xlUp).Value <> ""), 0).Row
        If UCase(Target) = "R" Then Cells(Target.Row, 1).EntireRow.Copy
        wsh.Range("A" & LR).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
End Sub

Thank you, rollis13. This work’s perfectly.

 

[rollis13]

Thanks for the positive feedback, glad having been of some help.