Zum aktuellen bzw. nächsten Geburtstag springen

Question

Hallo zusammen,
ich würde gern eine Mitgliederfatei so gestalten, dass beim öffnen Excel zum Namen mit dem aktuellen Geburtstag (aktuell=heute) btw. falls heute niemand Geburtstag hat, zum Namen springt, der als nächstes Geburtstag hat.
Funktioniert das Ganze dann nur, wenn die Datei nach Geburtstag sortiert ist, oder auch nach Geburtsdatum (wie im Moment) bzw. Namen sortiert ist?
Hinweis falls das wichtig ist: die Spalten G, H und I sind ausgeblendet.
Danke im voraus und Gruß Flodnug

Link für die Beispieldatei:
http://www.xup.in/dl,40658633/Mitgliederliste2.xlsm/

Answer 1

Hallo Flodnug,
hab Dir eine Geburtstagsliste erstellt,
vielleicht kannst Du sie ja verwenden.

Zeilen in den Monaten können gelöscht oder
neu eingefügt werden.

Gruß
fedjo

Answer 2

Hallo fedjo,
vielen Dank für die Mühe, die Du dir gemacht hast. Ich finde deine Datei richtig geil. Leider reicht sie für meine Zwecke nicht aus. Als Lösung nur für die Geburtstage, wäre das eine schöne Lösung. Da meine Datei aber eine Mitgliederliste ist, brauche ich meine Sortierkriterien. Kann man deine Msgbox nicht in meine Datei integrieren und trotzdem meine Sortierhriterien beibehalten?
Danke und Gruß Flodnug

Answer 3

Hallo Flodnug,
ein Versuch ist es wert!

Geburtstagsliste

Gruß
fedjo

Answer 4

Hallo fedjo,
danke nochmals.
Hoffentlich hat jemand eine Lösung für mich.
Flodnug

Answer 5

Hallo Flodnug,

das folgende Makro gehört in das VBA Projekt deiner Arbeitsmappe:

Private Sub Workbook_Open()
Dim GebArr As Variant
Dim lzeile As Long
Dim zaehler As Long
Dim gebDiv As Long
Dim strGef As String

'Tabelle mit der Geburtstagsliste aktivieren
ThisWorkbook.Worksheets("Tabelle1").Activate

'letzte Zeile in Spalte ermitteln
lzeile = ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row

'Array Re-Dimensioneren
ReDim GebArr(lzeile)

'Unterschied zwischen aktuellem Datum und Geburtstagsdatum im laufenden Jahr berechnen und in Array schreiben
For i = 5 To lzeile
GebArr(zaehler) = DateDiff("d", Date, DateSerial(Year(Date), Month(ActiveSheet.Cells(i, 6)), Day(ActiveSheet.Cells(i, 6))))
zaehler = zaehler + 1
Next i

'Variable für geringste Differnz zum aktuellem Datum vorbelegen
gebDiv = 999

'Nun Array durchlaufen und geringste Differnz suchen
For i = 0 To zaehler - 1
If GebArr(i) = 0 Or GebArr(i) > 0 Then 'nur wenn Differenz größer oder gleich Null ist
If gebDiv > GebArr(i) Then 'prüfen, welches kleinste Differnz ist
gebDiv = GebArr(i) 'Variable für Tagesdiffernz
End If
End If
Next i

'nun Array noch einmal durchlaufen und alle Zeilen, die der kleinsten Tagesdifferenz entsprechen in String für Markierung schreiben
For i = 0 To UBound(GebArr)
If GebArr(i) = gebDiv Then strGef = strGef & "B" & i + 5 & " ,"
Next i

'letztes Komma entfernen
strGef = Left(strGef, Len(strGef) - 1)

'gefundene Zeilen markieren
ActiveSheet.Range(strGef).Select
End Sub

Falls an einem Tag mehrere Geburtstage sind, werden alle Namen markiert.

Gruß

M.O.

Answer 6

Hallo M.O.,
danke erstmal für Deine Antwort.
Ich werde es gleich heute Abend ausprobieren.
Gebe Dir dann eine Rückmeldung.
Gruß Flodnug

Answer 7

Hallo M.O.,
wie versprochen heute noch meine Rückmeldung.
Es funktioniert wunderbar. Danke nochmal.
Habe Dein Makro noch ein bischen abgeändert, da nach jedem neuen Sortiervorgang die Markierung ja weg war.
Und ich wollte dann das Makro nochmal per Hand auslösen. Dazu habe ich im Netz gefunden, dass man nur in der ersten Zeile Public statt Private schreiben muss. Danach konnte ich eine Schaltfläche anlegen. Ich hoffe, das war richtig und es wird nicht irgendwas anderes beieinträchtigt. Es funktioniert jedenfalls noch alles.
Gruß Flodnug