Zoek macro

[tijmen amsing]

Ik ben bezig met het maken van een Excel worksheet waarin ik alle films met bijhorende informatie in wil hebben staan.

Ik heb hierbij al knoppen en macro's gemaakt voor het sorteren van data uit verschillende kolommen.
Daarnaast heb ik een macro voor het opzoeken van data (partial) uit de kolommen A t/m E.
Hierbij kan de gebruiker een zoekwoord invoeren die vervolgens gezocht wordt. Vervolgens worden de gehele rijen met de daarin een match geel gekleurd.
Dit werkt al vrij goed maar ik stuit op 1 ding, en zou verder nog twee dingen willen toevoegen.

Het probleem is het volgende:
Als ik niks invul of op cancel druk worden de rijen zonder data, maar die wel in de range van de macro zijn beschreven, geel gekleurd. Dit is natuurlijk niet de bedoeling.
Ik snap dat wanneer ik de range van de macro aanpas aan de precieze hoeveelheid van het aantal rijen die ik gebruik voor de films, dit probleem er niet zou zijn. Maar ik wil voorkomen dat ik, elke keer als ik een film toevoeg, de macro ook moet aanpassen.
Ik zou hier graag dus een oplossing voor hebben die er voor zorgt dat deze lege rijen niet gekleurd worden.

Daarnaast wil ik de volgende twee dingen toevoegen maar weet door mijn weinige ervaring in VBA niet hoe:
- Als er niks is ingevuld of er niks is gevonden moet er een messagebox komen met de tekst 'Niets gevonden.'
- Mijn filmlijst bedraagt enkele honderden rijen. Daarom wil ik dat Excel naar de rij springt met daarin de eerst gevonden match.


Dit is de code die ik zover heb:

Sub ZoekEnKleur()

Dim q As Range
Dim Findstr As String

Findstr = InputBox("Vul zoekterm in:", Title:="Zoeken")             ' Enter search string
If Findstr = "" Then MsgBox "Niets ingevuld."                       ' Msgbox when no search string
If Findstr = "" Then Exit Sub                                       ' Exit when no search string
With Worksheets(1).Range("A9", [E999])                              ' Reflect search range
Set q = .Find(Findstr, LookIn:=xlValues, Lookat:=xlPart)
If Not q Is Nothing Then
FirstAddress = q.Address
Do
Range(Cells(q.Row, 1), Cells(q.Row, 7)).Interior.ColorIndex = 36    ' Set color
Set q = .FindNext(q)                                                ' Look for next occurence of search string
Loop While q.Address <> FirstAddress
Else
    MsgBox Findstr & " is niet gevonden."                           ' Msgbox when nothing found
End If
End With

End Sub

Ik heb ook een voorbeeld van mijn worksheet toegevoegd.

Ik hoop dat iemand mij kan helpen.
Alvast bedankt

 

[tijmen amsing]

Het probleem dat ik aangaf is inmiddels opgelost. Ook komt er nu een messagebox wanneer er niks is ingevuld of er niets is gevonden.

Het enige wat ik nu nog graag zou willen is dat Excel moet springen naar de rij waarin de eerst gevonden match is.

 

[Cobbe]

Nu springt hij naar de cel met de gevonden waarde:

Sub ZoekEnKleur()

Dim q As Range
Dim Findstr As String

Findstr = InputBox("Vul zoekterm in:", Title:="Zoeken") ' Enter search string

With Worksheets(1).Range("A9", [D20]) ' Reflect search range
Set q = .Find(Findstr, LookIn:=xlValues, Lookat:=xlPart)
If Not q Is Nothing Then
FirstAddress = q.Address
Do
Range(Cells(q.Row, 1), Cells(q.Row, 7)).Interior.ColorIndex = 36 ' Set color
Set q = .FindNext(q) ' Look for next occurence of search string
Loop While q.Address <> FirstAddress
End If
End With
[COLOR="red"][B]Range(FirstAddress).Select[/B][/COLOR]
End Sub

Succes, Cobbe

 

[tijmen amsing]

Dat werkt inderdaad, bedankt!

Weet je of het ook mogelijk is dat wanneer ik op enter druk, ik bij de volgende match terecht kom? Net zoals wanneer je Ctrl+F gebruikt.

 

[Cobbe]

Ik hoop dat het voldoet:

Sub ZoekEnKleur()

Dim q As Range
Dim Findstr As String



Findstr = InputBox("Vul zoekterm in:", Title:="Zoeken") ' Enter search string
With Worksheets(1).Range("$A$9", [D20]) ' Reflect search range
Set q = .Find(Findstr, LookIn:=xlValues, Lookat:=xlPart)
If Not q Is Nothing Then
Firstaddress = q.Address
Do
Range(Cells(q.Row, 1), Cells(q.Row, 7)).Interior.ColorIndex = 36 ' Set color
Set q = .FindNext(q) ' Look for next occurence of search string
[COLOR="red"][B]Range(Firstaddress).Select
MsgBox ("Volgende ?")[/B][/COLOR]
Loop While q.Address <> Firstaddress
End If
End With
End Sub

Mvgr. Cobbe

 

[tijmen amsing]

Bedankt voor je suggestie maar hij geeft een syntax error wanner ik dit probeer..?

 

[Cobbe]

Ik heb de code terug aangepast, Startaddress is verwijderd, welk normaal gezien geen invloed heeft op de werking van de macro.
En natuurlijk heb ik die code eerst getest vooraleer ik hem post.
Alle code is eerst getest alvorens te posten, zoniet wordt dat vermeld.

Goede nacht.
Cobbe

 

[tijmen amsing]

Hoi,
Het werkt wel maar is toch niet helemaal waar ik op doel..
Ik ben al erg tevreden met het behaalde resultaat en denk dat ik het hier dan ook wel bij laat.

Bedankt:thumb:

 

[Cobbe]

Als het niet helemaal is wat je bedoelt waarom laat je dan niet gewoon weten wat je wel wil als resultaat.
Als ik het niet kan zijn er toch genoeg anderen op het forum die je wel verderhelpen.

Maar soms is het gewoon frusterend als je een antwoord krijgt op je aangereikte oplossing van "Het werkt niet" zonder te vermelden wat er dan precies fout loopt.
Daar kun je natuurlijk niets mee.

Vriendelijke groeten,

Cobbe

 

[tijmen amsing]

Haha oke sorry, dat was natuurlijk niet de bedoeling.

Ten eerste wil ik nog een fout in het script aanwijzen die wel opgelost moet worden:
Wanneer de macro niks heeft gevonden komt er een message box met de tekst dat er niets is gevonden. Maar door de toegevoegde regel:

Range(FirstAddress).Select

geeft hij vervolgens een fout omdat hij dus geen match vindt waar hij heen moet. Deze regel moet dus alleen worden uitgevoerd wanneer er een match is gevonden. Of de regel Exit Sub moet er komen na de message box.


Wat is graag zou willen hebben (n.a.v. je reactie)
Na het invullen van een zoekwoord en het drukken op OK, moeten alle matches al geel gekleurd worden en Excel me naar de rij brengt waar de eerst gevonden match is. (dit heb ik al voor elkaar)
Vervolgens moet Excel me naar de rij brengen met de volgende match wanneer ik op Enter druk, het liefst dus zonder message box waarbij ik niets meer in de sheet kan selecteren zonder op OK of kruisje te klikken.
Maar ik begrijp dat dit waarschijnlijk onmogelijk is omdat Enter al zijn eigen functie heeft binnen Excel.

Een andere manier is misschien het op zo'n manier te maken dat net zoals bij gebruik van CTRL+F je wel in de sheet kan klikken zonder dat de zoek applicatie sluit. Het enige verschil tussen mijn macro en de zoek functie van Excel is dat bij mij alle matches al gekleurd moeten zijn vanaf het begin. Ook zoekt mijn macro niet in alle kolommen.

Huidige code zover:

Sub ZoekEnKleur()

Dim q As Range
Dim Findstr As String



Findstr = InputBox("Vul zoekterm in:" & vbNewLine & vbNewLine & _
"       - Zoekt in: Genre, Titel, Jaar en Cast", Title:="Zoeken")   ' Enter search string
If Findstr = "" Then Exit Sub                                       ' Exit when no search string
With Worksheets(1).Range("A9", [D999])                              ' Reflect search range
Set q = .Find(Findstr, LookIn:=xlValues, Lookat:=xlPart)
If Not q Is Nothing Then
FirstAddress = q.Address
Do
Range(Cells(q.Row, 1), Cells(q.Row, 7)).Interior.ColorIndex = 36    ' Set color
Set q = .FindNext(q)                                                ' Look for next occurence of search string
Loop While q.Address <> FirstAddress
Else
    MsgBox Findstr & " is niet gevonden."                           ' Msgbox when nothing found
End If
End With
Range(FirstAddress).Select
End Sub

 

[Cobbe]

Dez doet alle gevonden rijen kleuren en de eerst gevonden waarde selecteren, maar dan houdt het ook op.

Sub ZoekEnKleur()
On Error GoTo Fout
Dim q As Range
Dim Findstr As String

Findstr = InputBox("Vul zoekterm in:", Title:="Zoeken") ' Enter search string

With Worksheets(1).Range("$A$9", [D20]) ' Reflect search range
    Set q = .Find(Findstr, LookIn:=xlValues, Lookat:=xlPart)
            If q Is Nothing Then MsgBox ("Niks gevonden!"): GoTo Fout
        If Not q Is Nothing Then
            Firstaddress = q.Address
    
    Do
        Range(Cells(q.Row, 1), Cells(q.Row, 7)).Interior.ColorIndex = 36 ' Set color
            Set q = .FindNext(q) ' Look for next occurence of search string
        Range(q.Address).Select
    Loop While q.Address <> Firstaddress
    Do
            Set q = .FindNext(q) ' Look for next occurence of search string
        Range(q.Address).Select
[B][COLOR="red"]'Hier zou de pauze moeten ingelast worden die weer verder kan lopen na bv Enter[/COLOR][/B]   
 Loop While q.Address <> Firstaddress
        End If
End With
Fout:
End Sub

Er zou een pauze moeten ingelast worden, dat is op zich geen probleem maar om na die pauze weer op het zelfde punt verder te gaan heb ik nog niet gevonden.

Succes, Cobbe

 

[tijmen amsing]

Oke bedankt, het foutje dat er in zat is in ieder geval weg nu.
Maar is de GoTo Fout nodig? hij doet het ook foutloos zonder namelijk.

Ik zou zelf verder ook niet weten hoe ik de pauze goed zou kunnen laten werken.

 

[Cobbe]

Dan haal je die Fout: en goto fout instructie toch gewoon weg.

Cobbe

 

[tijmen amsing]

heb ik al

bedankt voor je hulp. Ik ga het hier bij laten, ben erg blij met het resultaat.