handling error works only once

[haseft]

Hi!
On Sheet1 I have some text:
MytextA (cell A2)
MytextB
MytextC
MytextD
MytextE
MytextF

On Sheet2 I have some text:
MytextA Cells(j, 1)
MytextC
MytextE

Onerror works only once, Please help!

Sub FindText()
Dim a As String, n As String, z  As String, j As String
a = "StrgMal"
n = 1
z = a & n
j = 2
 
Application.ScreenUpdating = True
Worksheets("Sheet1").Activate
Range("A2").Select
 Do While ActiveCell.Value <> ""
        Sheets("Sheet2").Select
        Err.Clear
        On Error GoTo JumpToHere
        Columns("D").Find(What:=Sheets("Sheet1").Cells(j, 1)).Activate
        ActiveCell.Name = z
       n = n + 1
       z = a & n
 JumpToHere:
       Err.Clear
       j = j + 1
       Worksheets("Strategiskt_mål").Activate
       ActiveSheet.Cells(j, 1).Selec
Loop
End Sub

 

[Fluff]

Try

Sub FindText()
   Dim a As String, n As String, z  As String, j As String
   Dim Fnd As Range
   a = "StrgMal"
   n = 1
   z = a & n
   j = 2
   
   Application.ScreenUpdating = False
   Worksheets("Sheet1").Activate
   Range("A2").Select
   Do While activecell.Value <> ""
      Sheets("Sheet2").Select
      Set Fnd = Columns("D").find(What:=Sheets("Sheet1").Cells(j, 1))
      If Not Dn Is Nothing Then
         Fnd.Name = z
         n = n + 1
         z = a & n
      End If
      j = j + 1
      Worksheets("Strategiskt_mål").Activate
      ActiveSheet.Cells(j, 1).Selec
   Loop
End Sub

If you want to know why he error handler wasn't working as expected have a look at this
http://excelmatters.com/2015/03/17/on-error-wtf/

 

[haseft]

Tansk, its workning .

Sub FindText()
Dim a As String, n As String, z As String, j As String
Dim Dn As Range
a = "StrgMal"
n = 1
z = a & n
j = 2

Application.ScreenUpdating = False
Worksheets("Sheet1").Activate
Range("A2").Select
Do While ActiveCell.Value <> ""
Sheets("Sheet2").Select
Set Dn = Columns("D").Find(What:=Sheets("Sheet1").Cells(j, 1))
If Not Dn Is Nothing Then
Dn.Select
Dn.Name = z
n = n + 1
z = a & n
End If
j = j + 1
Worksheets("Sheet1").Activate
ActiveSheet.Cells(j, 1).Select
Loop
End Sub

 

[Fluff]

Glad to help & thanks for the feedback