Geburtstag über Msg Box anzeigen

[Primo Centurio]

Hallo miteinander

Ich habe den folgenden Coder, der mir beim öffnen der Arbeitsmappe anzeigt, falls jemand am aktuellen Tag Geburtstag hat.
Der Code funktioniert an sich nun habe ich folgendes Problem:

Falls zwei Leute am gleichen Tag Geburtstag haben macht er mir eine Msg Box auf mit den Angaben der ersten Person und nach dem wegklicken der Msg Box, eine zweite Msg Box mit den Angaben der ersten und der zweiten Person.

Wie kriege ich es hin, dass er mir nur die Box mit beiden Personen anzeigt?

Hier wäre der Code

Code:

Dim i As Integer
Dim bStr As String
bStr = "Heute hat, "
For i = 1 To Cells(65536, 5).End(xlUp).Row
   Debug.Print Cells(i, 5)
   If Format(Cells(i, 5).Value, "dd.mm.yyyy") = Format(Now, "dd.mm.yyyy") Then
       bStr = bStr & Cells(i, 3) & " " & Cells(i, 4) & " aus Zimmer " & Cells(i, 13) & " Geburtstag" & Chr$(13)
       MsgBox bStr
   End If
Next

Herzlichen Dank für eure Hilfe.

Freundliche Grüsse

Primo

[Kuwer]

Hallo Primo,

verscihebe die MsgBox unter Next.

Gruß Uwe

[Primo Centurio]

Hallo Uwe

Danke für die rasche Antwort.
Das habe ich auch schon versucht, leider erscheint dann auch die Msg Box aber nur mit dem vorgegebenen Text "Heute hat,"

Muss ich evt den Code so ändern, dass er den Befehl abbricht wenn das Datum nicht gleich Heute ist?

Grüsse Primo

[Klaus-Dieter]

Hallo,

sieh mal, ob dir das:

Code:

Sub test()
   Dim intZeile As Integer
   Dim varDatArr() As Variant
   Dim intAnz As Integer
   For intZeile = 2 To 10
       If CDate(Cells(intZeile, 1)) = Format(Now(), "dd.mm.yyyy") Then
           ReDim Preserve varDatArr(intAnz)
           varDatArr(intAnz) = Cells(intZeile, 2)
           intAnz = intAnz + 1
       End If
   Next intZeile
   MsgBox Join(varDatArr, vbLf)
End Sub

weiter hilft.

[Primo Centurio]

Hallo Klaus-Dieter

Herzlichen Dank für die Hilfe und den Code.
Dieser funktioniert wunderbar. Ich würde gerne noch zwei Anpassungen vornehmen und zwar folgende:

1. Ich würde der Msg Box gerne einen anderen Titel geben. Wenn diese "aufplopt" ist sie momentan mit "Microsoft Excel" angeschrieben.

2. Ich würde gerne, dass die Ausgabe auch mit Text dargestellt wird zum Beispiel so:
 "Heute hat " + Wert aus entsprechender Zelle  + "aus Zimmer" + Wert aus anderer Zelle + "Geburtstag"

Herzlichen Dank für deine Hilfe.

Freundliche Grüsse

Primo

[WillWissen]

Moin,

zu 1.: https://www.google.com/search?client=firefox-b-d&q=msgbox+titel+%C3%A4ndern

[Primo Centurio]

Moin Günter


Danke für den Link zu Google  :21: :71:
Habe es nun nach 100 versuchen hingekriegt den Titel zu ändern.

Gruss Primo

[Primo Centurio]

Habe ein wenig herumprobiert und es eigentlich hingekriegt.

Der Code lautet nun wie folgt:

Code:

Dim intZeile As Integer
Dim a As String
Dim b As String
Dim varDatArr() As Variant
Dim intAnz As Integer
For intZeile = 3 To 1000

   If CDate(Cells(intZeile, 5)) = Format(Now(), "dd.mm.yyyy") Then
          ReDim Preserve varDatArr(intAnz)
          varDatArr(intAnz) = Cells(intZeile, 13)
          intAnz = intAnz + 1
   End If

  Next intZeile
 
   a = "Heute haben Bewohner aus"
   b = "folgenden Zimmern Geburtstag: "

  MsgBox a & vbNewLine & b & vbNewLine & vbNewLine & Join(varDatArr, vbLf), , "Geburtstage"

End Sub

Nun bleibt nur noch die Frage wie ich einen zweiten Wert, wie ich einen zweiten Wert auf der gleichen Zeile in die MsgBox einfügen kann.


Freundliche Grüsse

Primo

[schauan]

Hallöchen,

du siehst ja, wie in dem Code a und b verdrahtet sind. Nun nimmst Du einfach noch c dazu, in welcher Zeile auch immer … Musst aber c auch noch deklarieren und mit Inhalt versehen …

[Primo Centurio]

Hallo André

Danke für deine Antwort. Ich habe es zum Teil geschafft aber leider nur zum Teil.
Bin es mit deiner Hilfe wie folgt angegangen:

Code:

Dim intZeile As Integer
Dim a As String
Dim b As String
Dim c As Variant
Dim d As Variant
Dim varDatArr() As Variant
Dim intAnz As Integer
For intZeile = 3 To 1000

   If CDate(Cells(intZeile, 5)) = Format(Now(), "dd.mm.yyyy") Then
          ReDim Preserve varDatArr(intAnz)
          varDatArr(intAnz) = Cells(intZeile, 13)
          c = Cells(intZeile, 3)
          d = Cells(intZeile, 4)
          intAnz = intAnz + 1
   End If
   Next intZeile
 
   a = "Heute haben Bewohner aus"
   b = "folgenden Zimmern Geburtstag: "
  MsgBox a & vbNewLine & b & vbNewLine & vbNewLine & Join(varDatArr, " " & c & " " & d & " " & vbLf), , "Geburtstage"
 
End Sub

Bei der MsgBox (siehe Attachment) kommt der zweite Wert nun raus jedoch an der falschen Stelle (bei zimmer 103 anstelle von 103B) und bei 103 sollte auch ein Wert (Name) stehen. Was habe ich nicht beachtet oder wo habe ich den Fehler drin?

Lg Primo