verjaardagen selecteren

[jong.braster]

Ik heb een sheet met een lijst met namen (kolom A), emailadressen (kolom B) en geboortedata (kolom C).
Nu wil ik op een andere sheet een kort lijstje met namen, emailadressen en geboortedata (dus de hele regel) die 3 dagen voor en 7 dagen na de huidige datum zijn.
Dit lijstje moet dan iedere dag ververst worden.
Is er iemand die dit kan en wil bedenken?

 

[edmoor]

Als je ook even een voorbeeld documentje plaatst dan hoeft iemand die je best wel wil helpen dat niet zelf te verzinnen. Dus met gegevens die binnen en buiten het aangegeven bereik vallen.

 

[jong.braster]

Hallo Edmoor,
Goed idee.

 

[edmoor]

Niet volledig uitgewerkt zoals je wilde maar er zitten wel de berekeningen in die je ervoor kunt gebruiken.

in E1 staat de datum van vandaag.
In E2 staat het aantal dagen sinds 01-01-1900 voor de geboortedag in het jaar dat in E1 staat.
In G2 staat het aantal dagen dat de verjaardag is verwijderd van de dag in E1.
In I2 staat een formule die kijkt of dat aantal dagen langer dan 3 dagen geleden is over over maximaal 7 dagen is.
Met deze aanwijzingen kun je zelf het document in elkaar steken zoals je wilt.

Meneer of mevrouw Kakernaak van A2 heb ik een geboortedatum gegeven die binnen die periode valt.
Dan kan hij/zij vast gebak bestellen

Bekijk bijlage voorbeeld Verjaardagen.xlsx

 

[jong.braster]

Hallo Edmoor,
Even snel getest en wat gewijzigd. Werkt goed.
Bedankt voor je snelle hulp.
Morgen ga ik er even me verder.

 

[edmoor]

Ok dan :thumb:

 

[pasan]

Of achter werkblad 2, de lijst wordt dus alleen ververst bij activeren van dit werkblad

Private Sub Worksheet_Activate()
Range("A2:C100").ClearContents
For Each it In Sheets("Blad1").Columns(3).SpecialCells(xlConstants)
  If IsDate(it) Then jarig = DateSerial(Year(Date), Month(it), Day(it))
  a = DateDiff("d", Date, jarig)
  If a >= -3 And a <= 7 Then
    R = it.Row
    N = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Cells(N, 1).Resize(, 3).Value = Sheets("Blad1").Cells(R, 1).Resize(, 3).Value
  End If
Next
End Sub

Maar misschien wil je het achter een knop hebben zodat je zelf bepaald wanneer de lijst ververst wordt
In een module

Sub verjaardag()
Sheets("Blad2").Range("A2:C100").ClearContents
For Each it In Sheets("Blad1").Columns(3).SpecialCells(xlConstants)
  If IsDate(it) Then jarig = DateSerial(Year(Date), Month(it), Day(it))
  a = DateDiff("d", Date, jarig)
  If a >= -3 And a <= 7 Then
   R = it.Row
    With Sheets("Blad2")
      N = .Cells(Rows.Count, 1).End(xlUp).Row + 1
      .Cells(N, 1).Resize(, 3).Value = Sheets("Blad1").Cells(R, 1).Resize(, 3).Value
    End With
  End If
Next
End Sub

 

[pasan]

iets korter

Private Sub Worksheet_Activate()
Range("A2:C10000").ClearContents
For Each it In Sheets("Blad1").Columns(3).SpecialCells(xlConstants)
  If IsDate(it) Then jarig = DateSerial(Year(Date), Month(it), Day(it))
  If DateDiff("d", Date, jarig) >= -3 And DateDiff("d", Date, jarig) <= 7 Then
    Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(, 3) = Sheets("Blad1").Cells(it.Row, 1).Resize(, 3).Value
  End If
Next
End Sub

 

[jong.braster]

Hallo Pasan,
Blij dat je even mee denkt.
Bijgevoegd heb ik een voorbeeld.
sheet 1 = (voorblad) hierop wil ik graag een lijstje met namen/email-adressen/geb.data
sheet 2 = het klantenoverzicht

Jouw oplossing lijkt me goed maar wil je aangeven hoe ik dat in het document moet zetten zodat ik het over kan nemen in het origineel.
A.u.b. de lijst verversen als het voorblad wordt geopend.

 

[pasan]

klik onderaan op het tabblad "voorblad" met je rechter muis knop en selecteer Programma code weergeven, je ziet de de code achter dit blad
Deze code plak je dan in jou originele bestand en sheet (tabblad) "voorblad".
In jou origineel moet wel een blad voorkomen met de naam "formule jarigen" en hier moet de lijst met alle jarigen in staan zoals in jou voorbeeld in kolom A en B en C, en in kolom C moeten de datums staan

 

[jong.braster]

Halo Pasan,
Ik sta versteld van je kennis. Bedankt voor je hulp ik ben erg blij, maar............... ik heb nog wat vragen.

Het blad "formule jarigen" bestaat uit de kolommen A t/m G.
In de programmacode verwijs je naar "Coloms 3"
Betekend dat dat je de kolommen D-E-F-G niet gebruikt en verwijderd kunnen worden?

Wil je wijzigen:
de selectie op het "voorblad" in kolom A= datum, kolom B= naam en kolom C= emailadres?
en de selectie selecteren op datum?

De programmacode wil ik overzetten naar een ander document.
Op dat andere document komt de geselecteerde datum/naam/emailadres op een andere plaats op de sheet.
Deze komen in de kolommen E-F-G vanaf regel 8.
(Waar) Kan ik in de programmeercode de plaats wijzigen waar de selectie moet komen?

 

[HSV]

Wist je trouwens dat er ongeborenen tussen zitten met naam en e-mailadres?

Iets eenvoudiger geschreven.

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Range("A3:C10000").ClearContents
For Each it In Sheets("formule jarigen").Columns(7).SpecialCells(xlConstants)
  If IsDate(it) Then jarig = DateSerial(Year(Date), Month(it), Day(it))
    If jarig - Date >= -3 And jarig - Date <= 7 Then
      Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 3) = it.Offset(, -2).Resize(, 3).Value
    End If
  Next
Range("A3:C" & Cells(Rows.Count, 1).End(xlUp).Row).Sort [C3]
End Sub

 

[pasan]

als je een voorbeeld plaatst is het verstandig om deze te maken zoals het uiteindelijk ook de bedoeling is
Columns 3 is dus kolom C waar jij je datums hebt staan dus pas Columns (3) aan . als jij je datums in een andere kolom hebt staan
Vanuit gaande dat jou blad gegevens beginnen in kolom A
de it is jou kolom met datums de -offset zijn het aantal kolommen geteld vanaf jou datums kolom naar de eerste kolom.
dus deze kun je aanpassen

it.Offset(, [COLOR="#FF0000"]-2[/COLOR]).[COLOR="#FF0000"]Resize(, 3)[/COLOR].Value

met Resize pak je alle cellen dan vanaf de eerste kolom tot zover jij het wil
Als het niet lukt dan,
plaatst je een voorbeeld bestand die er net zo uitziet als jou origineel zonder gevoelige info, als de indeling er maar het zelfde uit ziet

 

[jong.braster]

Hallo Pasan,
Je hebt gelijk, ik weet er te weinig van om jou goeds te kunnen volgen en daarom
is een voorbeeld beter.

Bijgevoegd een voorbeeld met de indeling zo als het wordt.

 

[pasan]

probeer deze eens..
Heb de datums niet in de eerste kolom gezet

 

[jong.braster]

Beste Pasan,
Wederom sta ik versteld, gisteren avond en vanmorgen ben ik lekker bezig geweest. Je motiveert mij.Hier en daar wat aangepast en zeer tevreden. Mijn complimenten.
Echter maak ik graag nog meer gebruik van je kennis.
Wil je voor mij nog één programmaatje maken.

DOEL:
op sheet "voorblad" vermelden hoeveel klanten er geregistreerd zijn in het klant overzicht

Dus:
het aantal gebruikte regels tellen op sheet "klant overzicht" , kolom A
het aantal vermelden op sheet "voorblad" regel 11, kolom D

zie voorbeeld

 

[pasan]

in de vba code wordt in D11 het aantal neer gezet er staat een min 1 achter omdat je A2 niet mee wil tellen
in C 11 staat gewoon een formule die het zelfde doet
kolom A wordt dus geteld, als je in A1 ook nog iets neerzet moet je dus min 2 in de vba code of formule in het blad zetten

 

[jong.braster]

sorteren van namen op geboortedatum( zie voorbeeld)

Hallo,
Na veel overleg en testen heb ik het volgende verzoek:
Kunnen de geselecteerde klanten op blad 1 op datum (dag/maand) gesorteerd worden.

Nu worden ze gesorteerd op (geboorte)jaar.


Het document bestaat uit 2 bladen.
Blad 1 = het voorblad.
Blad 2 is een klantbestand.

Op blad 2 worden de klanten geselecteerd die "2 dagen voor" en "5 dagen na" de huidige datum (op dit moment 19 aug) jarig zijn.
Op blad 1 worden deze klanten weergegeven in kolom E-F-G (vanaf regel 3)
Ze worden weergeven in de volgorde van (geboorte) jaar. Dit is niet van belang omdat het om de verjaardag gaat.
Kunnen deze klanten op datum/maand gesorteerd worden.

Bijgevoegd een voorbeeld met daarin de VBA code.

 

[pasan]

in kolom H worden de datums neer gezet van kolom G, als de dag van toen met het jaar van nu
Op kolom H wordt gesorteerd en daarna wordt kolom H weer leeg gemaakt

Private Sub Worksheet_Activate()
Dim it As Range
Dim jarig As Date

Range("E3:H20000").ClearContents
For Each it In Sheets("klant overzicht").Columns(3).SpecialCells(xlConstants)
  If IsDate(it) Then jarig = DateSerial(Year(Date), Month(it), Day(it))
  
  If DateDiff("d", Date, jarig) >= -3 And DateDiff("d", Date, jarig) <= 7 Then
       Cells(Cells(Rows.Count, 5).End(xlUp).Row + 1, 5).Resize(, 3) = Sheets("klant overzicht").Cells(it.Row, 1).Resize(, 3).Value
  End If
  
Next

 For Each it In Columns(7).SpecialCells(xlConstants)
   Cells(it.Row, 8) = DateSerial(Year(Date), Month(it), Day(it))
 Next

Range("E3:H" & Cells(Rows.Count, 5).End(xlUp).Row).Sort [H3]
Columns(8).ClearContents
End Sub

 

[jong.braster]

VBA werkt niet goed na wijziging Excel sheet

Hallo Pasan,
Bedankt voor je snelle en prima oplossing.
Maar nu heb ik nog het volgende:

Ik heb een sheet gewijzigd en nu krijg ik een foutmelding en wil je iets voor mij wijzigen in de code.

Wil je onderzoeken wat er in de VBA gewijzigd moet worden om:
- de foutmelding te voorkomen en
- de punten die ingevuld worden in het Userform1 te plaatsen in "klant overzicht" kolom D.

Nu worden de punten geplaatst in kolom B.