Lege cellen juist onder cellen met specifieke tekst zoeken

[samabert]

Hallo iedereen,

In het voorbeeld een uitgeklede versie van een logboek dat wij al 5 jaar gebruiken.

Om aan te tonen dat je een dag gelezen hebt, teken je die dag via het plaatsen (dubbelklikken) van een kruisje, dit verloopt via een login met paswoord.

Vanaf E1 tot T1 krijg je het resultaat van de niet getekende dagen.

Nu als iemand langere tijd niet aanwezig was en veel dagen moet lezen en tekenen kan er al eens iets vergeten zijn te tekenen en wordt het later zoeken.

Mijn vraag: Is er via VBA een mogelijkheid om per naam (keuze via de ComboBox), stapsgewijs de rijen waar niet is getekend te doorlopen en dus de mogelijkheid te hebben om te tekenen.

 

[cow18]

die combobox heb ik er nog niet ingezet, gewoon een inputbox waar je je initialen geeft.
Die initialen zijn die zo slordig, dat je die de helft van de tijd niet opgeeft in de volgende rijen ?

Sub Niet_Getekend()
     Dim c1    As Range, FA

     initiaal = InputBox("geef initiaal", , "HLA")     '---> iets om je initiaal op te geven

     With Sheets("test")
          r = Application.Match(initiaal, Sheets("test").Rows(4), 0)     'in de 4e rij staan je initialen
          Set c = Intersect(.Columns(r), .UsedRange)     'gebruikt bereik in die column
          Set c1 = c.Find(initiaal, , , xlWhole)     'vind eerste initiaal
          If Not c1 Is Nothing Then
               FA = c1.Address               'adres 1e initiaal
               Do
                    If c1.Offset(1).Value = "" Then     'cel er onder leeg
                         Application.Goto c1.Offset(1)     'ga naar die cel
                         Select Case MsgBox("Wil je tekenen ?" & vbLf & "ja = akkoord" & vbLf & "neen= niet akkoord" & vbLf & "Annuleren=stoppen", vbYesNoCancel, "cel : " & c1.Offset(1).Address(0, 0) & "   " & Format(c1.Offset(1, 1 - c1.Column).Value2, "ddd dd-mm-yy"))
                              Case vbYes: c1.Offset(1).Value = "x"     'je wil tekenen
                              Case vbCancel: Exit Sub     'je wil stoppen
                         End Select
                    End If
                    Set c1 = c.FindNext(c1)  'volgende initiaal
                    b = c1 Is Nothing
                    If Not b Then b = c1.Address = FA
               Loop While Not b
          End If
     End With
End Sub

 

[cow18]

eigenaardig, ik kan geen code meer netjes neerzetten ??? Dat is nu een lelijke platte tekst.

 

[edmoor]

Even testen:

Code regels
    Code regels

Werkt hier goed.
Misschien een tijdelijk probleempje geweest.

 

[cow18]

gisteren avond vermoedelijk niet goed het lint afgezocht, het zat netjes achter die 3 puntjes

Sub Niet_Getekend()
     Dim c1    As Range, FA

     initiaal = InputBox("geef initiaal", , "HLA")     '---> iets om je initiaal op te geven

     With Sheets("test")
          r = Application.Match(initiaal, Sheets("test").Rows(4), 0)     'in de 4e rij staan je initialen
          Set c = Intersect(.Columns(r), .UsedRange)     'gebruikt bereik in die column
          Set c1 = c.Find(initiaal, , , xlWhole)     'vind eerste initiaal
          If Not c1 Is Nothing Then
               FA = c1.Address               'adres 1e initiaal
               Do
                    If c1.Offset(1).Value = "" Then     'cel er onder leeg
                         Application.Goto c1.Offset(1)     'ga naar die cel
                         Select Case MsgBox("Wil je tekenen ?" & vbLf & "ja = akkoord" & vbLf & "neen= niet akkoord" & vbLf & "Annuleren=stoppen", vbYesNoCancel, "cel : " & c1.Offset(1).Address(0, 0) & "   " & Format(c1.Offset(1, 1 - c1.Column).Value2, "ddd dd-mm-yy"))
                              Case vbYes: c1.Offset(1).Value = "x"     'je wil tekenen
                              Case vbCancel: Exit Sub     'je wil stoppen
                         End Select
                    End If
                    Set c1 = c.FindNext(c1)  'volgende initiaal
                    b = c1 Is Nothing
                    If Not b Then b = c1.Address = FA
               Loop While Not b
          End If
     End With
End Sub

 

[HSV]

En dan gewoon kiezen voor 'Algemene code' @cow18 .

 

[edmoor]

Ik tik de codetags altijd zelf in.

 

[HSV]

Deed ik ook bij php code, maar zat te zoeken waar @cow18 die 'Uitgebreid (BBcode):' vandaan had.
Nu zag ik voor het eerst een lijstje bij 'Taal:' waar alles in staat.

 

[samabert]

Cow18,

Dit is maar een voorbeeld, in het echte bestand komen alle initialen op elke rij terug, anders kan je ze niet handtekenen.

Trouwens jij hebt jaren geleden nog mee gewerkt tot het tot stand brengen van dit logboek.

Deze code werkt helemaal hoe ik het voor ogen had.

Weerom enorm bedankt!

 

[cow18]

< test met zelf de codetags er in te zetten
zoals edmoor aangaf />

oei, @edmoor, welke codetags tik je dan in ?

 

[cow18]

@samabert, dat was nog in de oertijd van "worksheet.nl" of niet ???

 

[edmoor]

oei, @edmoor, welke codetags tik je dan in ?

Gewoon als:
[ CODE ]

[ /CODE ]
Maar dan zonder de spaties.

Dat doe ik ook met:
[ PHP ]

[ /PHP ]
Voor formules.

In VBA code maak ik tevens de commentaren groen.
Maar dat kan in deze nieuwe forum software helaas (nog) niet.
Ik heb er al wel om gevraagd.

 

[cow18]

Bedankt

Bedankt

<b>bedankt</b>

 

[samabert]

@cow18, dat is juist, dat moet ergens in 2016 geweest zijn.

 

[samabert]

Toch nog een extra vraag over de code in #5

Indien per ongeluk een verkeerd initiaal of helemaal geen initiaal wordt ingevoerd krijg je een fout op volgende regel:

Set c = Intersect(.Columns(r), .UsedRange)     'gebruikt bereik in die column

Hoe kan je dit opvangen?

 

[cow18]

na dit moet je eerst die r afvragen

 With Sheets("test")
          r = Application.Match(initiaal, Sheets("test").Rows(4), 0)     'in de 4e rij staan je initialen
         if not isnumeric(r) then msgbox "foutboodschap":exit sub
         ..... rest

 

[snb]

Waarom niet in het werkblad zelf ?
dubbelklik op 1 van de initialen in rij 2
dubbelklik in de lege cellen
dubbelklik op de initiaal in rij 2 voor het volldige overzicht.

 

[samabert]

@cow18,

Dit werkt helemaal, bedankt voor de aanpassing

 

[samabert]

@snb,

Knap gedaan, maar wat er die dag is gebeurd moet ook nog tevoorschijn komen, want voor iemand een dag gaat afvinken moet hij wel eerst het event lezen.

Ik heb geprobeerd van dit aan te passen, maar dit is mij niet gelukt.

Met de code van cow18, gaat het eenvoudiger zijn om dit nu te integreren in het logboek. Toch ga ik in mijn vrije tijd jouw uitvoering proberen in te bouwen in een testversie van het logboek, altijd leerzaam en uitdagend.