Zoek en vervangen mogelijkheid in VBA code

[boom1001]

Mijn vraag
Ik ben opzoek naar een code die het zelfde doet bij de optie "zoek en vervangen". Ik wil graag alleen de optie krijgen om iets te zoeken en daarna een kleur te geven. Dit is gelukt! Als ik deze code onder een commnand knap verstop werk alles goed, maar "scrolt" deze niet naar het het gene waar ik naar zoek. Dit gebeurd wel in de "crl-f" functie.

code:

Private Sub CommandButton2_Click()
Dim xRg As Range
Dim xFRg As Range
Dim xStrAddress As String
Dim xVrt As Variant
xVrt = Application.InputBox(prompt:="Search:", Title:="Zoek...")
If xVrt <> "" Then
Set xFRg = ActiveSheet.Cells.Find(What:=xVrt)
If xFRg Is Nothing Then
MsgBox prompt:="Cannot find this value", Title:="Zoek..."
Exit Sub
End If
xStrAddress = xFRg.Address
Set xRg = xFRg
Do
Set xFRg = ActiveSheet.Cells.FindNext(After:=xFRg)
Set xRg = Application.Union(xRg, xFRg)
Loop Until xFRg.Address = xStrAddress
If xRg.Count > 0 Then
xRg.Interior.ColorIndex = 8
xRsp = MsgBox(prompt:="Gevonden!", Buttons:=xlNone)
If xRsp = vbOK Then xRg.Interior.ColorIndex = xlNone
End If
End If
End Sub

Wat ik al gevonden of geprobeerd heb
zoeken zoeken en nog eens zoeken op internet.

[g0tanks]

boom1001 schreef op donderdag 21 januari 2021 @ 21:45:
Wat ik al gevonden of geprobeerd heb
zoeken zoeken en nog eens zoeken op internet.

Waar heb je op gezocht? Met de zoektermen 'excel vba move screen to active cell' kom ik in ieder geval veelbelovende resultaten tegen.

[boom1001]

Allereerst ; bedankt! Ziet inderdaad veelbelovend uit. Ik heb bovenstaand scriptje van internet geplukt, dus ik moet even kijken waar en hoe ik dit ga combineren met de verschilden opties als ik die zoekopdracht ingeef. Mocht je tips hebben hoor ik het natuurlijk heel graag! 😃

[boom1001]

Twas even zwoegen, maar heb de oplossing gevonden:

code:

Private Sub CommandButton2_Click()
Dim xRg As Range
Dim xFRg As Range
Dim xStrAddress As String
Dim xVrt As Variant
xVrt = Application.InputBox(prompt:="Ticket:", Title:="Zoek...")
If xVrt <> "" Then
Set xFRg = ActiveSheet.Cells.Find(What:=xVrt)
If xFRg Is Nothing Then
MsgBox prompt:="Ticket niet gevonden...", Title:="Zoek..."
Exit Sub
End If
xStrAddress = xFRg.Address
Application.Goto ActiveCell.EntireRow, True
Set xRg = xFRg
Do
Set xFRg = ActiveSheet.Cells.FindNext(After:=xFRg)
Set xRg = Application.Union(xRg, xFRg)
Loop Until xFRg.Address = xStrAddress
If xRg.Count > 0 Then
xRg.Interior.ColorIndex = 8
xRsp = MsgBox(prompt:="Gevonden!", Buttons:=xlNone)
If xRsp = vbOK Then xRg.Interior.ColorIndex = xlNone
End If
End If
End Sub

Lijn 14 toegevoegd en werk als een trein. Bedankt voor het opweg helpen.