Copy line if any cells in column are present in named range COUNTIF

Question

Very new to VBA but really need help on this code.

So, I'd like to copy any cells in Column L in Worksheet1, IF the name is in my named range (in Lookuptab sheet).

So far I have the code for the copy and paste and it works fine but since putting in the countif criteria, I get the error compile error sub function not defined

Please help!

Thanks,

My code is as follows:

a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

    If CountIf(Sheets("Lookup").Range("Vendor_Lookup"), Sheets("Sheet1").Cells(i, 12).Value) > 0 Then

        Worksheets("Sheet1").Rows(i).Copy

        Worksheets("Sheet2").Activate

        b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Sheet2").Cells(b + 1, 1).Select

        ActiveSheet.Paste

        Worksheets("Sheet1").Activate

End If

Next

Application.CutCopyMode = False


End Sub

Answer 1

CountIf is not native to VBA. You have to access the worksheet function via

Application.WorksheetFunction.CountIf(......

---

A couple other notes:

1. No need to Activate anything per this post
2. Copying/pasting inside a loop can be time consuming. Consider using a Union to collect target rows
3. Instead of using CountIf, you could use Range.Find to stick with native VBA functions

Combining all of this yields something like below:

Sub SHELTER_IN_PLACE()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")

Dim lr As Long, i As Long
Dim Target As Range, Found As Range

lr = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row

For i = 2 To lr
    Set Found = Sheets("Lookup").Range("Vendor_Lookup").Find(ws1.Range("A" & i))

        If Not Found Is Nothing Then
            If Not Target Is Nothing Then
                Set Target = Union(Target, ws1.Range("A" & i))
            Else
                Set Target = ws1.Range("A" & i)
            End If
        End If

    Set Found = Nothing
Next i

If Not Target Is Nothing Then
    lr = ws2.Range("B" & ws2.Rows.Count).End(xlUp).Offset(1).Row
    Target.EntireRow.Copy
    ws2.Range("A" & lr).PasteSpecial xlPasteValues
End If

End Sub