Copying rows to another workbook based on if a cell holds a numeric value / condition: isnumeric = true

Question

Still a newb and have stumbled across accidental success in the middle of writing this post, but will still post it in an attempt to learn more about autofilter and how conditional references work inside loops/other conditional things. Plus hopefully this post can help someone else.

I'm trying to write a VBA macro that will copy rows from workbook1 to workbook2 based on if cell N(x) in the row to be copied holds a numeric value or not. Basically, I'm trying to create a database that tracks if we received excess samples which we then store in-house.

In workbook1, If the value of # of samples received is higher than the # shipped, the remainder is displayed in column "N". If not it returns "". I'd like to copy any row that returns a value in column N to workbook2.

I've found a bunch of posts on copying rows based on conditions, but I can't seem to get any of the code to work when I modify it. Below are two examples of incomplete code I've tried to modify. (I accidentally completed the second code while writing this post but I'm not sure why it suddenly works now...)

Sub ESWcopypaste()

    Dim ESW As Workbook, AW As Workbook, Awksht As Worksheet, ESwksht As Worksheet
    Dim LR As Long, i As Long
    Dim R As Range

    Set AW = ThisWorkbook
    Set Awksht = AW.Worksheets("RECORDS")
    Set R = Awksht.Range([A2], Range("A" & Rows.Count).End(xlUp)) <-"Have tried a few variations here. I still have a problem where it reads a cell with a formula that returns "" as numeric and includes them in the count..."

    Workbooks.Open ("filepath to the ESW workbook")
    Set ESW = Application.Workbooks("Extra Samples Catalog.xlsm")
    Set ESwksht = ESW.Worksheets(3)

    CR = ESwksht.Range("A" & Rows.Count).End(xlUp).Row <- "will be used to locate empty space to paste the contents, possible unnecessary when using autofilter"

    On Error Resume Next
        With R
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To LR
            .AutoFilter , field:=1, Criteria1:=(If IsNumeric(Range("N" & i).Value) = True)
            .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                Sheets("ESwksht").Range("A" & Rows.Count).End(xlUp).Offset(1)
            .AutoFilter
        End With
    On Error GoTo 0

End Sub

The above code is based on the post linked below. I can't seem to figure out how to make the filter criteria into a working version of this "Criteria1:=(If IsNumeric(Range("N" & i).Value) = True)", which isn't correct, just me mashing the keyboard in an attempt to get it working... https://www.mrexcel.com/board/threads/help-need-vba-code-to-copy-rows-to-a-new-worksheet-based-on-criteria.359760/

My first attempt was to use conditional copy and paste. It was getting stuck at the line to paste, giving me a error 13 type mismatch message. I changed

ESwksht.Range(R).Offset(1).PasteSpecial Paste:=xlPasteValues

to

ESwksht.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

and now it works, idk why though... Working code is below.

Sub CPESampleData()

    Dim ESW As Workbook, AW As Workbook, Awksht As Worksheet, ESwksht As Worksheet
    Dim LR As Long, i As Long
    Dim R As Range

    Set AW = ThisWorkbook
    Set Awksht = AW.Worksheets("RECORDS")
    Set R = Awksht.Range("A" & Rows.Count).End(xlUp)

    Workbooks.Open ("C:filepath to Extra Samples Catalog.xlsm")
    Set ESW = Application.Workbooks("Extra Samples Catalog.xlsm")
    Set ESwksht = ESW.Worksheets(3)
    CR = ESwksht.Range("A" & Rows.Count).End(xlUp).Row

    AW.Activate

    With AW.Sheets("RECORDS")
        AW.Activate
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To LR
            If IsNumeric(Range("N" & i).Value) = True Then
                Awksht.Rows(i).Copy
                ESwksht.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            End If
        Next i
    End With

    ESwksht.Activate

End Sub

The code above was modified from these two posts. https://www.mrexcel.com/board/threads/vba-conditional-copy-paste.468926/ VBA copy rows that meet criteria to another sheet

Answer 1

Copy Filtered Rows to Another Workbook

Copy Rows With a Number in Column (Values Only)

• In VBA, a cell is considered numeric even if it is empty i.e. if the following is true: in VBA IsEmpty(Range("A1").Value) or the equivalent in Excel ISBLANK(A1).
• When you don't have empty cells, it is 'ok' to use IsNumeric(Range("A1").Value) but I mostly prefer the safer (more accurate) VarType(Range("A1").Value) = vbDouble.

Sub CopyIfNumberRows()
    
    Dim swb As Workbook: Set swb = ThisWorkbook
    Dim sws As Worksheet: Set sws = swb.Worksheets("RECORDS")
    Dim strg As Range: Set strg = sws.Range("A1").CurrentRegion
    Dim sdrg As Range: Set sdrg = strg.Resize(strg.Rows.Count - 1).Offset(1)
    Dim Data As Variant: Data = sdrg.Value
    Dim cCount As Long: cCount = UBound(Data, 2)
    
    Dim sr As Long, dr As Long, c As Long, WasDataCopied As Boolean
    
    For sr = 1 To UBound(Data, 1)
        If VarType(Data(sr, 14)) = vbDouble Then ' is a number
            dr = dr + 1
            For c = 1 To cCount
                Data(dr, c) = Data(sr, c)
            Next c
        End If
    Next sr
    
    If dr = 0 Then GoTo WriteMessage

    Application.ScreenUpdating = False
    
    Dim dwb As Workbook:
    Set dwb = Workbooks.Open("C:\Test\Extra Samples Catalog.xlsm")
    Dim dws As Worksheet: Set dws = dwb.Worksheets(3)
    Dim dfcell As Range:
    Set dfcell = dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1)
    Dim drg As Range: Set drg = dfcell.Resize(dr, cCount)
    
    drg.Value = Data

    'dwb.Close SaveChanges:=True

    Application.ScreenUpdating = True

    WasDataCopied = True
    
WriteMessage:
    
    If WasDataCopied Then
        MsgBox "If-number rows copied.", vbInformation
    Else
        MsgBox "No if-number rows found.", vbExclamation
    End If

End Sub

Copy Rows With Non-Nlank Cell in Column (Values, Formatting and Formulas)

Sub CopyNonBlanksAutoFilter()
    
    Application.ScreenUpdating = False

    Dim swb As Workbook: Set swb = ThisWorkbook
    Dim sws As Worksheet: Set sws = swb.Worksheets("RECORDS")
    sws.AutoFilterMode = False
    Dim strg As Range: Set strg = sws.Range("A1").CurrentRegion
    Dim sdrg As Range: Set sdrg = strg.Resize(strg.Rows.Count - 1).Offset(1)
    
    Dim svrg As Range, WasDataCopied As Boolean
    
    strg.AutoFilter Field:=14, Criteria1:="<>"
    On Error Resume Next
        Set svrg = sdrg.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    sws.AutoFilterMode = False
    
    If svrg Is Nothing Then GoTo WriteMessage
    
    Dim dwb As Workbook:
    Set dwb = Workbooks.Open("C:\Test\Extra Samples Catalog.xlsm")
    Dim dws As Worksheet: Set dws = dwb.Worksheets(3)
    Dim dfcell As Range:
    Set dfcell = dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1)
    
    svrg.Copy dfcell
    
    'dwb.Close SaveChanges:=True
    
    WasDataCopied = True
    
WriteMessage:
    
    Application.ScreenUpdating = True
    
    If WasDataCopied Then
        MsgBox "Non-blanks copied.", vbInformation
    Else
        MsgBox "No non-blanks found.", vbExclamation
    End If

End Sub