2 waarden zoeken

[pasan]

Hallo

Met onderstaande code wilde ik in 2 kolommen 2 waarden zoeken
in kolom BK staan persoons namen, soms vaker als 1 maal de zelfde naam onder elkaar
in kolom BL staan datums, per naam komt 1 keer de zelfde datum voor maar in de kolom kan de zelfde datum vaker voor komen
Maar helaas werkt het niet zoals ik me voor gesteld had

hopelijk kan iemand mij ook met dit probleem helpen

Private Sub Cbogegevensverwijderen_Click()
ActiveSheet.Unprotect Password:=""
Application.ScreenUpdating = False
    
    Dim findstring As Variant
    Dim Rng As Range
    
    For i = 1 To 7
        If Me("Ch" & i) Then
            findstring = DateValue(Me("Txtdatum" & i))
            
            With ActiveSheet.Range("BL:BL")
                Set Rng = .find(What:=findstring, _
                        after:=.cells(.cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                        
              findstring = Txtnaam
            With ActiveSheet.Range("BK:BK")
                Set Rng = .find(What:=findstring, _
                        after:=.cells(.cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                    If Not Rng Is Nothing Then
                        Application.Goto Rng, False
                        ActiveCell.Delete Shift:=xlUp
                        ActiveCell.Offset(0, 1).Delete Shift:=xlUp
                        ActiveCell.Offset(0, 2).Delete Shift:=xlUp
                        ActiveCell.Offset(0, 3).Delete Shift:=xlUp
                    End If
                   
            End With
            End With
        End If
    Next
Unload Me
ThisWorkbook.Save
Application.ScreenUpdating = True
ActiveSheet.Protect Password:=""
End Sub

 

[HSV]

Het werkt ongeveer zo.

Sub tst()
Set c = Columns(1).Find(Range("G1"), , xlValues, xlWhole)
  If Not c Is Nothing Then
 Do Until c.Offset(, 1) = Range("H1")
  Set c = Columns(1).FindNext(c)
    Loop
   c.Select
 End If
End Sub

 

[pasan]

HSV dank je wel ik ga er mee aan de slag

 

[pasan]

gelukt

HSV bedankt voor je hulp het is me gelukt :thumb::thumb:

Private Sub Cbogegevensverwijderen_Click()
ActiveSheet.Unprotect Password:=""
Application.ScreenUpdating = False
 For i = 1 To 7
        If Me("Ch" & i) Then
Set c = Columns(63).find(Txtnaam, , xlValues, xlWhole)
  If Not c Is Nothing Then
 Do Until c.Offset(, 1) = DateValue(Me("Txtdatum" & i))
  Set c = Columns(63).FindNext(c)
    Loop
   c.Select
   
   ActiveCell.Delete Shift:=xlUp
   ActiveCell.Offset(0, 1).Delete Shift:=xlUp
   ActiveCell.Offset(0, 2).Delete Shift:=xlUp
   ActiveCell.Offset(0, 3).Delete Shift:=xlUp
 End If
 End If
Next

Unload Me
ThisWorkbook.Save
Application.ScreenUpdating = True
ActiveSheet.Protect Password:=""
End Sub

 

[HSV]

Graag gedaan,

Ik loop niet je gehele code bijlangs, maar dit kan iets anders.

loop
  c.resize(, 4).delete shift:=xlup
   end if
 end if
next

 

[pasan]

Uitstekend......:thumb: Bedankt

 

[HSV]

Ik weet niet of je een foutafvanging nodig bent, als de waarde niet aanwezig is.
Anders blijft het in een eindeloze loop.

firstaddress = c.Address
 Do Until c.Offset(, 1) = DateValue(Me("Txtdatum" & i))
  Set c = Columns(63).FindNext(c)
     If c.Address = firstaddress Then Exit Sub
Loop
   c.Resize(, 4).Delete shift:=xlUp
 End If

 

[pasan]

HSV de foutafvanging gaat niet helemaal goed
stel ik heb 6 oplopende datums opgeslagen met de zelfde naam bijv: 1-2-12, 2-2-12, 4-2-12, 5-2-12, 6-2-12, 7-2-12.
als ik ze allemaal wil verwijderen dan stokt het na 2-2-12 de form unload niet als ik de form zelf afsluit verdwijnen alleen de eerste 2 datums de rest blijft staan.
het gaat wel goed als de datums opeenlopend aanwezig zijn dan worden ze zonder probleem gewist.

 

[HSV]

Misschien kun je het bestandje er bij doen.

 

[pasan]

het bestand

 

[HSV]

Kun je me een beetje wegwijs maken hoe te handelen in de Userform?

 

[pasan]

De userform laad de eerst oplopende datum vanaf de geselecteerde cel in elke txtdatum
je hebt dan de keuze om elke datum aan te vinken met de checkbox bovenaan of je kiest maar 1 dag uit
Zelfde met de uren of 1 keer uren invullen boven aan en de heel week krijgt de zelfde uren of alsje maar 1 snipperdag wil vul je maar 1 dag in
In de sheet is 4 januarie geel de werk week duurt 7 dagen (daarom heb ik voor 7 dagen automatisch ophalen gekozen) als ik dan de hele week wil snipperen
vul ik 1 keer 8 uur in en selecteer Snipperen (mijn naam had ik al geselecteerd in de sheet) ik selecteer selectall en elke datum wordt weg geschreven met mijn naam en aantal uren.
Maar als ik dan toch in het midden van die vrij genomen werkweek een dag wil aanpassen ga ik weer op die maandag staan, roep de form op en selecteer de dag en pas of de uren aan of de reden of de opmerking of alle drie

 

[HSV]

Ik heb het een paar keer op verschillende manieren geprobeerd, maar alles loopt goed (of ik doe niets verkeerd).
Eigenlijk heb je de foutafvanging niet nodig, de gegevens staan altijd in de Userform als ze in het blad staan.

 

[pasan]

als ik van die 7 dagen de 3e dag verwijder en de form sluit is er niks aan de hand
als ik daarna de zelfde week weer in de form laad en alle dagen selecteer en op verwijderen klik gaat het wel mis,

of ik moet de spel regels goed uitleggen of met een msgbox dit ondervangen
ik ga dr maar es op broeden

 

[HSV]

Ok, nu zie ik het.
Verander het laatste stukje eens zo als onderstaand.

If Not c Is Nothing Then
  FirstAddress = c.Address
 Do Until c.Offset(, 1) = DateValue(Me("Txtdatum" & i))
  Set c = Columns(63).FindNext(c)
     If c.Address = FirstAddress Then GoTo einde
Loop
   c.Resize(, 4).Delete Shift:=xlUp
 End If
 End If
einde:
Next

Unload Me

 

[pasan]

Mijn dank is groot het klopt as een bus :thumb:

HSV bedankt, zoals je ziet in het rooster moet ik er morgen weer vroeg uit haha ik wens je een goed weekend en je ziet me hier vast wel weer eens langskomen

 

[HSV]

Graag gedaan,

ik kan je ook een BV dag geven. :d