zoeken in een tabel

[don42]

Hallo allemaal,

ik heb in Blad2 een hoop data staan in de cellen c2:q289
hier staan willekeurig datums in
nu wil ik graag van een ander tabblad bv Blad1 een datum invoeren
en dan met een button naar Blad2 en dat de juiste datum geselecteerd word
elke datum komt maar 1 keer voor
is zoiets mogelijk?

Don

 

[josrnm]

Kun je geen filter in blad 2 zetten, en deze dan op de bewuste datum filteren

 

[don42]

Natuurlijk zou dat kunnen maar die datums staan in willekeurige kolommen
dit is niet de oplossing wat ik zoek

 

[sylvester-ponte]

ctrl h

 

[VenA]

Met Ctrl h zoeken op een ander blad? Werk dit eens even uit (zonder VBA):d

@don42, Plaats even een voorbeeldje. Dan hoeven wij dat niet voor jou te doen.

 

[sylvester-ponte]

VenA, je hebt gelijk, zoder vba ben ik helemaal nergens.
maar met: neem een macro op met ctrl h enz.. en je macro is bijna af.

 

[VenA]

@sylvester-ponte,
Een macro met Ctrl h (zoeken en vervangen):shocked:

Een optie als de de datum wijzigt in blad1 B1:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B1")) Is Nothing Then
    For Each cl In Sheets("blad2").Range("C2:Q289")
        If cl = Sheets("Blad1").Range("B1") Then
            Application.Goto cl
            Exit Sub
        End If
    Next cl
End If
Application.Goto Target
MsgBox Format(Range("B1"), "dd-mm-yyyy") & "   Niet gevonden in Blad2", vbCritical, "Niet gevonden"
End Sub

 

[don42]

VenA dit werkt super bedankt
Nog 1 vraagje zou de target ook een kleurtje kunnen hebben maar dan eenmalig niet als ik over het tabblad "surf"

zoiets als

Application.Goto Target en dan......    Interior.Color = vbBlue

maar ook nu ben ik heel blij met de oplossing

 

[VenA]

Wat bedoel je met over het blad surfen?

Zet in Z300 jouw standaard opmaak. En probeer deze eens.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B1")) Is Nothing Then
    Target.Offset(, 1).ClearContents
    Application.ScreenUpdating = False
    With Sheets("blad2")
        .Range("Z300").Copy
        .Range("C2:Q289").PasteSpecial Paste:=xlPasteFormats
        Application.CutCopyMode = False
        For Each cl In .Range("C2:Q289")
            If cl = Sheets("Blad1").Range("B1") Then
                Application.Goto cl
                With cl
                    .Interior.Color = vbBlue
                    .Font.ThemeColor = xlThemeColorDark1
                End With
                Application.ScreenUpdating = True
                Exit Sub
            End If
        Next cl
    End With
    Target.Offset(, 1) = "Niet gevonden"
    Application.ScreenUpdating = True
End If
End Sub

 

[HSV]

Of:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Target.Address(0, 0) = "B1" Then
 Target.Offset(, 1).ClearContents
   With Sheets("blad2").Range("C2:Q289")
    Set c = .Find(Target.Value, , , xlWhole)
      If Not c Is Nothing Then
            .Interior.ColorIndex = xlNone
            c.Interior.Color = vbBlue
            Application.Goto c
        Else
            Target.Offset(, 1) = "Niet gevonden"
      End If
    End With
  End If
End Sub

 

[don42]

beide bedankt voor de mooie oplossingen
ik ga er mee aan de slag
moet nu lukken helemaal top :thumb: