Hallo Montagnard,
Je hebt uiteraard het volste recht om zoals je het zelf noemt old skool code te gebruiken, maar er zitten toch wel een aantal overbodige zaken in. Select heb je om te beginnen al helemaal niet nodig, en bij GOTO gaan de meesten ook huiveren.
Ik ben er zeker van dat je mits enige inspanning een meer gestructureerde code ook weet te begrijpen. Zelf zou ik het nog helemaal anders doen dan onderstaande, hoor, maar ik heb er iets enigszins in jouw stijl van gemaakt, in de hoop dat je daar inspiratie in vindt.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Application.EnableEvents = False
If Target <> "" Then
Tezoekentitel = Cells(2, 2)
Range("b4:b13,d4:d13").ClearContents
Startlijn = 15: positie = 4: teller = 1
For I = Startlijn To Cells(Rows.Count, 1).End(xlUp).Row
lijsttitel = Cells(I, 1).Value
Rem zoeken naar overeenkomende titel(s)
Zoekop = InStr(1, lijsttitel, Tezoekentitel, vbTextCompare)
If Zoekop > 0 Then
Rem er is overeenkomst
Cells(I, 1).Copy Cells(positie, 2)
Cells(positie, 4) = I: Rem geef de lijn aan waar de titel staat
positie = positie + 1: teller = teller + 1
End If
If teller > 10 Then
MsgBox "er zijn teveel titels met dezelfde tekst , verfijn Uw zoekopdracht", vbInformation, "Belangrijke info"
Range("b4:b13,d4:d13").ClearContents
Application.EnableEvents = True
Exit Sub
End If
Next I
If teller = 1 Then
MsgBox "er zijn geen titels met deze tekst", vbInformation, "Belangrijke info"
End If
Else
Range("b4:b13,d4:d13").ClearContents
End If
Application.EnableEvents = True
End If
End Sub
PS : Warme bakkertje was blijkbaar nog een minuutje eerder met een gelijkaardig plan!