Search code examples
vbaloopsfor-loopiterationskip

VBA How to continue showing arrays elements after nothing


I have a problem with my excel macro. I would like to find names in the excel file and copy it to different cells. I created an array with names and FOR loop to check it. In that for loop i'm looking for names from array. The problem is: If there is no name from array in the cells program stops and give me MsgBox "No name: " + persons(j) and after this program stops. Is is possible to give user information "there is no that name in the file" and skip this iteration ?

Many thanks for help !

Here is my code:

Sub wyszukaj()
    Dim persons As Variant
    persons = Array("Dawid", "Mikael", "John", "Alice", "Katerine")
    Dim rowNum As Long
    Dim foundRowNum As String
    Dim findName As String
    Dim j As Long

    For j = LBound(persons) To UBound(persons)
        Dim found As Range
        Dim curSheet As Worksheet
        Dim LastCell As Range
        Dim FirstAddr As String
        With Range("A:A")
            Set LastCell = .Cells(.Cells.Count)
        End With
        Dim nothingInCell As Object
        Set nothingInCell = Nothing

        Set FoundCell = Range("A:A").Find(persons(j), After:=LastCell)

        If FoundCell Is Nothing Then
            MsgBox ("No name: " + persons(j))
        End If

        Debug.Print FoundCell.Value

        If Not FoundCell <> persons(j) Then
            FirstAddr = FoundCell.Address
        End If
        Next j

        Dim counter As Integer
        Dim i As Integer
        counter = 0

        Do Until FoundCell Is Nothing
            counter = counter + 1
            Set FoundCell = Range("A:A").FindNext(After:=FoundCell)
            If FoundCell.Address = FirstAddr Then
                Exit Do
            End If
        Loop

        foundRowNum = FoundCell.Address
        rowNum = Range(foundRowNum).Row

        For i = rowNum To rowNum + counter - 1
            Cells(i, 1).Copy Cells(i, 8)
            Cells(i, 2).Copy Cells(i, 9)
        Next i
End Sub

Solution

  • You need to use the following structure:

    If FoundCell Is Nothing Then 
        'nothing found
    Else
        'something found
    End If
    

    All the part that relies on FoundCell needs to be in the Else part above.

    Sub wyszukaj()
        Dim persons As Variant
        persons = Array("Dawid", "Mikael", "John", "Alice", "Katerine")
        Dim rowNum As Long
        Dim foundRowNum As String
        Dim findName As String
        Dim j As Long
    
        For j = LBound(persons) To UBound(persons)
            Dim found As Range
            Dim curSheet As Worksheet
            Dim LastCell As Range
            Dim FirstAddr As String
            With Range("A:A")
                Set LastCell = .Cells(.Cells.Count)
            End With
            Dim nothingInCell As Object
            Set nothingInCell = Nothing
    
            Set FoundCell = Range("A:A").Find(persons(j), After:=LastCell)
    
            If FoundCell Is Nothing Then
                'nothing found
                MsgBox ("No name: " + persons(j))
            Else
                'something found
                Debug.Print FoundCell.Value
        
                If Not FoundCell <> persons(j) Then
                    FirstAddr = FoundCell.Address
                End If
            End If
        Next j
    
        Dim counter As Long
        Dim i As Long
        counter = 0
    
        Do Until FoundCell Is Nothing
            counter = counter + 1
            Set FoundCell = Range("A:A").FindNext(After:=FoundCell)
            If FoundCell.Address = FirstAddr Then
                Exit Do
            End If
        Loop
    
        foundRowNum = FoundCell.Address
        rowNum = Range(foundRowNum).Row
    
        For i = rowNum To rowNum + counter - 1
            Cells(i, 1).Copy Cells(i, 8)
            Cells(i, 2).Copy Cells(i, 9)
        Next i
    End Sub