Sunday School Test.xlsm | ||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|
D | E | F | G | H | I | J | K | L | M | |||
1 | Phone | Name | Birthday | Phone | Address | City | State | Zip | ||||
2 | Glen@mail.com | 816-552- | Cindy | 1-Feb | Cindy@mail.com | 816-557 | 17 Elm | Raymore | MO | 64083 | ||
3 | John@mail.com | 816-553 | Susan | 21-Nov | Susan@mail.com | 816-558 | 18 Ash | Peculiar | MO | 64078 | ||
4 | Janie@mail.com | 816-554 | 19 Walnut | Raymore | MO | 64078 | ||||||
5 | Glenna@mail.com | 816-555 | 20 Oak | Raymore | MO | 64083 | ||||||
6 | Jim@mail.com | 816-556 | Kathy | 4-Nov | Kathy@mail.com | 816-559 | 21 Pecan | Raymore | MO | 64083 | ||
Contacts |
I have this worksheet and I want to create a birthday list on a second worksheet.
My output should be in the form
Jan 4 First and Last Name
Feb 7 First and Last Name
I am trying to do it with copying only non blank cells and the cells next to them onto another table on the second sheet.
Here is my code
VBA Code:
Sub CopyAndPasteNonBlanks()
Dim rng As Range
Set rng = Range("C2:C50").SpecialCells(xlCellTypeConstants)
rng.Copy Range("O2")
Set rng = Range("B2:B50").SpecialCells(xlCellTypeConstants)
rng.Copy Range("P2")
Set rng = Range("A2:A50").SpecialCells(xlCellTypeConstants)
rng.Copy Range("Q2")
Set rng = Range("G2:G50").SpecialCells(xlCellTypeConstants)
rng.Copy Range("O7")
Set rng = Range("F2:F50").SpecialCells(xlCellTypeConstants)
rng.Copy Range("P7")
Set rng = Range("A2:A50").SpecialCells(xlCellTypeConstants)
rng.Copy Range("Q7")
End Sub
Here is my result
I need the code to find the first blank cell for the second set of names.
I also need the last names to only paste if the first name is not blank
Can one of you fine folks help me out?
I plan on using mail merge on this list into a Word document for printing.