Look for match, copy if no match

[femma]

Hi Forum!

I'm trying to copy all the values that are not found into column J. But get an error at the line

Selection.Copy Destination:=Sheets(1).Range(lastrange).Paste

Any ideas why?

Option Explicit
Sub codeforP()
Dim lastrange As Long
Dim lastrow1 As Long
Dim lastrow2 As Long
Dim business As Variant
Dim i As Long
Dim a As Long
lastrange = Sheets(1).Range("J" & Rows.Count).End(xlUp).Row
lastrow1 = Sheets(1).Range("I50000").End(xlUp).Row
lastrow2 = Sheets(1).Range("F57000").End(xlUp).Row

For i = 2 To lastrow1
    business = Sheets(1).Cells(i, "I").Value
    For a = 1 To lastrow2
        If Sheets(1).Cells(a, "F").Value = business Then
            
        Else

        Sheets(1).Cells(a, "F").Select
        Selection.Copy Destination:=Sheets(1).Range(lastrange).Paste
        
        
        
        
        End If
        
    Next a
Next i

MsgBox "ok"

End Sub

 

[steve the fish]

Couple of problems. It doesnt need the .Paste and also lastrange is just an integer so you are basically saying as an example Range(1) which makes no sense. Maybe also you want to paste into the lastrange + 1 (ie the cell below the last used cell)? Anyway something like this perhaps:

Selection.Copy Destination:=Sheets(1).Range("J" & lastrange +1)

 

[njimack]

Untested (so use on a copy of your data) but this should work and will run much faster than your approach...

Sub codeforP()
Dim Last_Row As Long
Dim i As Long

Application.ScreenUpdating = False

With Sheets(1)
    Last_Row = Cells(Rows.Count, 9).End(xlUp).Row
    For i = 2 To Last_Row
        If .Cells(i, 6) = .Cells(i, 9) Then .Cells(i, 6).Copy .Cells(i, 10).End(xlUp).Offset(1)
    Next i
End With
Application.ScreenUpdating = True
End Sub

 

[femma]

Thanks for the replies!
njimack - what should I do if I want to copy the values that are not matches - those that are not found?

 

[njimack]

Ah my bad. Change this​

If .Cells(i, 6) = .Cells(i, 9) Then .Cells(i, 6).Copy .Cells(i, 10).End(xlUp).Offset(1)

to this

If .Cells(i, 6) [COLOR=#FF0000][B]<>[/B][/COLOR] .Cells(i, 9) Then .Cells(i, 6).Copy .Cells(i, 10).End(xlUp).Offset(1)

 

[Fluff]

Another option

Sub codeforP()

Dim UsdRws As Long
Dim Cl As Range

With Sheets(1)
    For Each Cl In .Range("F2", .Range("F" & Rows.Count).End(xlUp))
        If WorksheetFunction.CountIf(.Columns(9), Cl.Value) = 0 Then
            .Range("J" & Rows.Count).End(xlUp).Offset(1).Value = Cl.Value
        End If
    Next Cl
End With
MsgBox "ok"

End Sub