Use VBA code to copy and paste a specific selection

[Joe Walsh]

Hi everyone,

I am trying to find out how to write a vba code that will copy individual rows that have ID codes (in column D) that do not match the master list of ID codes on sheet "ID Codes" column A. Then I need to paste the copied rows into a new sheet called "print sheet" in the next availbe row. Any ideas as to how I would even start this???

Thanks!

[Solus Rankin]

Sub LooptyLoop()

    Dim lRow1 As Long
    Dim lRow2 As Long
    Dim l As Long
    Dim ll As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    
    Set ws1 = Sheets("Search Codes")
    Set ws2 = Sheets("ID Codes")
    Set ws3 = Sheets.Add(, Sheets(Sheets.Count))
    lRow1 = ws1.Range("D65536").End(xlUp).Row
    lRow2 = ws2.Range("A65536").End(xlUp).Row
    
    For l = 2 To lRow1
        For ll = 2 To lRow2
            If ws1.Range("D" & l).Value = ws2.Range("A" & ll).Value Then
                ws1.Range("D" & l).EntireRow.Copy Destination:=ws3.Range("A65536").End(xlUp).Offset(1, 0)
            End If
        Next ll
    Next l

End Sub

Untested.

e/ I forgot to mention. You'll have to change Search Codes here:

Set ws1 = Sheets("Search Codes")

To the name of the worksheet you're searching from.

[Joe Walsh]

IT works well the only problem is pastes the rows into a new sheet instead of my "Print Sheet", also it only copied the same row from the bottom of my list instead of just the row from the top. Any ideas??

[Solus Rankin]

If Print Sheet already exists (I thought you wanted a new sheet) then change this:

Set ws3 = Sheets.Add(, Sheets(Sheets.Count))

to this:

Set ws3 = Sheets.("Print Sheet")

I'm not sure which list you're speaking of or what is in the bottom/top row. Is there an example workbook you could attach with a before and after? This would aid in coming up with a complete solution. To attach a workbook, press the 'Go Advanced' button below, and then the paperclip icon in the tool bar.

[Joe Walsh]

I have attatched the workbook

Concat.xlsm

[Solus Rankin]

I noticed the ID Codes on the Notes tab are on there multiple times, therefore they will get copied multiple times.

Try:

Sub LooptyLoop()

    Dim lRow1 As Long
    Dim lRow2 As Long
    Dim l As Long
    Dim ll As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    
    Set ws1 = Sheets("Notes")
    Set ws2 = Sheets("ID Codes")
    Set ws3 = Sheets("Print Sheet")
    lRow1 = ws1.Range("D65536").End(xlUp).Row
    lRow2 = ws2.Range("A65536").End(xlUp).Row
    
    For l = 2 To lRow1
        For ll = 2 To lRow2
            If ws1.Range("D" & l).Value = ws2.Range("A" & ll).Value Then
                ws2.Range("A" & ll).EntireRow.Copy Destination:=ws3.Range("A65536").End(xlUp).Offset(1, 0)
            End If
        Next ll
    Next l

End Sub

[Joe Walsh]

I updated what Im trying to accomplish

Concat.xlsm

[Solus Rankin]

Private Sub CommandButton1_Click()

'IF the ID Code in Cloumn D in Notes is blank ("") or does not match the list of ID codes in sheet"ID CODES"
'then copy and past the entire row of the ID code into the "Print sheet" in the next available row

    Dim lRow1 As Long
    Dim lRow2 As Long
    Dim l As Long
    Dim ll As Long
    Dim strTest As String
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    
    Set ws1 = Sheets("Notes")
    Set ws2 = Sheets("ID Codes")
    Set ws3 = Sheets("Print Sheet")
    lRow1 = ws1.Range("D65536").End(xlUp).Row
    lRow2 = ws2.Range("A65536").End(xlUp).Row
    
    For l = 2 To lRow1
        strTest = ws1.Range("D" & l).Value
        For ll = 2 To lRow2
            If ws2.Range("A" & ll).Value = strTest Then
                ws1.Range("A" & l).EntireRow.Copy Destination:=ws3.Range("D65536").End(xlUp).Offset(1, 0)
            End If
        Next ll
    Next l

End Sub