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
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