VBA Find #N/A value and copy adjacent cells to another sheet and loop

Question

Good day to everyone,

I have been trying to find an answer here that would fit my problem but I have been unsuccessful. I am using FIND to search column F for cell with #N/A value and copy adjacent cells to another "Sheet2" at the end of the column A. I have made the following code that works but my problem is I want to make it to loop to find the next cell with #N/A value till find all.

Sub Find()
    Dim SerchRange As Range
    Dim FindCell As Range
    Set SerchRange = Range("F:F")
    Set FindCell = SerchRange.FIND(What:="#N/A", _
      LookIn:=xlValues, _
      LookAt:=xlWhole, _
      SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, _
      MatchCase:=False)

    If FindCell Is Nothing Then
        MsgBox "Nothing was found all clear"    
    Else
        FindCell.Select
        ActiveCell.Offset(0, -3).Resize(, 3).Select
        Selection.Copy
        Sheets("Sheet2").Select
        Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
    End If
End Sub

Additionally I recommend to read How to avoid using Select in Excel VBA and apply this technique to your code. — Pᴇʜ

DirtyDeffy DirtyDeffy · Accepted Answer · 2018-11-07T12:01:36

Try this and let me know if it works:

Option Explicit
Sub Find()
Application.ScreenUpdating = False
Dim SearchRange As Range
Dim FindCell As Range
Dim Check As Boolean
Dim LastRow As Long
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim FindCounter As Long

Set ws = ThisWorkbook.Worksheets("Sheet1") ' <--- Insert the name of your worksheet here
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
LastRow = ws.Cells(Rows.Count, "F").End(xlUp).Row ' <--- Finds the last used row
Set SearchRange = Range("F1:F" & LastRow)
FindCounter = 0

For Each FindCell In SearchRange
    If FindCell.Value = "#N/A" Then
        FindCounter = FindCounter + 1
        FindCell.Offset(0, -3).Resize(, 3).Copy
        ws2.Range("A" & ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial xlPasteValues
    End If
Next

MsgBox "Succes!" & vbNewLine & vbNewLine & "This many cells were found: " & FindCounter
Application.ScreenUpdating = True
End Sub

VBA Find #N/A value and copy adjacent cells to another sheet and loop

1 Answers