waarde zoeken en daarna markeren

[monkey1601]

Ik heb een bestand met gegevens en nu heb ik een functie dmv een macro toegevoegd om getal te zoeken.
Als het getal gevonden is wordt de rijnummer weergegeven.


Graag zou ik dit uitbreiden met de volgende optie:.
Als het getal/gegeven gevonden, de rij wordt gemarkeerd met een kleur
Hoe moet ik dit oplossen mbv VBA

 

[JeanPaul28]

met toevoeging van deze code

Cells(c.Row, 1).Resize(1, 6).Interior.Color = 65535

 

[HSV]

Zoiets.

Sub zoekrij()
Dim c As Range
Dim TeZoekenWaarde
Columns(1).Resize(, 6).Interior.Color = xlNone
TeZoekenWaarde = InputBox("Te zoeken sysnr:")
Set c = Columns(1).Find(TeZoekenWaarde)
If Not c Is Nothing Then _
c.Resize(, 6).Interior.Color = vbYellow
End Sub

Of anders geschreven.

Sub zoekrij()
Dim rw
Columns(1).Resize(, 6).Interior.Color = xlNone
 rw = Application.Match(Val(InputBox("Te zoeken sysnr:")), Columns(1), 0)
 If Not IsError(rw) Then Cells(rw, 1).Resize(, 6).Interior.Color = vbYellow
End Sub

 

[VenA]

Of iets met het autofilter

Sub VenA()
c00 = InputBox("Te zoeken sysnr:")
If Trim(c00) = "" Then Exit Sub
Application.ScreenUpdating = False
With Blad1.Cells(1).CurrentRegion
  .Interior.Color = xlNone
  .AutoFilter 1, c00
  .Offset(1).SpecialCells(2).Resize(, 6).Interior.Color = vbYellow
  .AutoFilter 1
End With
End Sub

En eigenlijk heb je dan de hele sub niet nodig. Maak gewoon gebruik van het filter

Edit. Moet nog wel een beetje aangepast worden voor als je een niet bestaand nummer invoert.

 

[monkey1601]

iedereen bedankt voor de reactie,

Alle oplossingen zijn bruikbaar.

Toch nog een vraag voor optimalisatie
De knop voor de zoekfunctie is nu geplaatst ter hoogte van Rij 3.
Stel de gevonden waarde ligt nu bij rij 40.
Moet nu naar beneden scrollen om te zien dat de waarde gemarkeerd/vonden is,
Graag zou ik zien dat de cursor ook naar die gevraagde positie wordt verplaatst zodat scrollen niet noodzakelijk is,

bvd

 

[HSV]

Sub zoekrij()
Dim rw
Columns(1).Resize(, 6).Interior.Color = xlNone
 rw = Application.Match(Val(InputBox("Te zoeken sysnr:")), Columns(1), 0)
 If Not IsError(rw) Then
   Cells(rw, 1).Resize(, 6).Interior.Color = vbYellow
   Application.Goto Cells(rw, 1), -1
End If
End Sub

Edit:
In het bestandje staat een userform met knop die op dezelfde positie blijft t.o.v. een gewone knop.

 

[monkey1601]

HSV, Harry

bedankt voor je aanpassing .
Om alles perfect te maken zou het mooi zijn dat de rand waarin staat "Userform " (zie vraag001.png) vervalt, dus alleen het knopje "zoek sysnr" (vraag002.png) overblijft.

 

[HSV]

Koppel onderstaande code eens aan je commandbutton uit het bestandje dat je plaatste (dus zonder de userform).

Private Sub CommandButton1_Click()
Dim rw
ActiveSheet.UsedRange.Interior.Color = xlNone
rw = Application.Match(Val(InputBox("Te zoeken sysnr:")), Columns(1), 0)
   With ActiveWindow
    If Not IsError(rw) Then
           Cells(rw, 1).Resize(, 6).Interior.Color = vbGreen
          .ScrollRow = Cells(rw - 5, 1).Row
        With .VisibleRange.Offset(1, 6)
          CommandButton1.Top = .Top
          CommandButton1.Left = .Left
        End With
      Else
         .ScrollRow = 1
         CommandButton1.Top = 75
         CommandButton1.Left = 275.25
    End If
 End With
End Sub

 

[monkey1601]

Beste Harry,

onderstaande code zit onder de button:

Sub zoekrij()
Dim rw
Columns(1).Resize(, 6).Interior.Color = xlNone
rw = Application.Match(Val(InputBox("Te zoeken sysnr:")), Columns(1), 0)
If Not IsError(rw) Then Cells(rw, 1).Resize(, 6).Interior.Color = vbYellow
End Sub


Als het goed is moet ik deze vervangen door de door u opgegeven Code?

Als dat zo is krijg ik foutmelding:


Anders heb ik niet begrepen wat de bedoeling is.

bvd
Monique

 

[HSV]

Maak een nieuwe button uit ActiveX-controls aan.
Dubbelklik erop en plak de code in het witte vlak.

 

[VenA]

Niet helemaal. Je moet een commandbutton in het bestand zetten en daar de code onder zetten. De code heb ik iets aangepast.

 

[monkey1601]

Beste HSV, VenA,

Bedankt voor het meehelpen naar de gevraagde oplossing.
Het werkt nu naar behoren.:thumb::thumb:

Monique