XL2000
I've been happily using the following to copy a range of non-contiguous
checkmarks under current date on one sheet to a range on another sheet
under current date:

Sub CopyToday()
Dim Rng As Range
Set Rng = Rows(2).Find(Date).Offset(1, 0)
Range(Rng, Rng.Offset(Range("Attendance").Rows.Count - 1, 0)).Copy _
Destination:=Sheets(3).Range(Rng.Address)
End Sub

Now "the boss" needs another identical source sheet that will have a
different set of checkmarks under current date, so now there will be 2 sets
of checkmarks to copy into this destination. I looked at Union(), but from
what I've read, it doesn't work with ranges from different sheets.

Playing out options in my mind, I thought maybe copying both sets to
columns in a temporary location then use Union() in a third column in that
temporary location to "merge" the checkmarks, then copy that range to the
destination, then delete the temporary location, but that seems like a lot
to do to accomplish what should be easier. Besides, I can't come up with
the code to do that anyway.

Can anyone help me get all checkmarks from 2 sheets into my Destination?

--
David

Sub CopyToday()
Dim Rng As Range
Dim sh as Worksheet
set sh = Worksheets("Sheet1")
With sh
Set Rng = .Rows(2).Find(Date).Offset(1, 0)
.Range(Rng, Rng.Offset(Range("Attendance").Rows.Count - 1, 0)).Copy _
Destination:=Sheets(3).Range(Rng.Address)
End With
set sh = Worksheets("Sheet2")
With sh
Set Rng = .Rows(2).Find(Date).Offset(1, 0)
.Range(Rng, Rng.Offset(Range("Attendance").Rows.Count - 1, 0)).Copy _
Destination:=Sheets(3).Range(Rng.Address)(1).end(x ldown)(2)
End With
End Sub

You leave out many important details such as where to place the second set
of data, what the sheet names are and so forth. For the second range, I
have left in the Range("Attendance") part, but clearly that would not
correspond to the second set of data, so you would need to change how the
extent of the second range is determined. But basically the approach is to
do two copy operations, with the second placed below the first.

--
Regards,
Tom Ogilvy

"David" wrote in message
...
XL2000
I've been happily using the following to copy a range of non-contiguous
checkmarks under current date on one sheet to a range on another sheet
under current date:

Sub CopyToday()
Dim Rng As Range
Set Rng = Rows(2).Find(Date).Offset(1, 0)
Range(Rng, Rng.Offset(Range("Attendance").Rows.Count - 1, 0)).Copy _
Destination:=Sheets(3).Range(Rng.Address)
End Sub

Now "the boss" needs another identical source sheet that will have a
different set of checkmarks under current date, so now there will be 2
sets
of checkmarks to copy into this destination. I looked at Union(), but from
what I've read, it doesn't work with ranges from different sheets.

Playing out options in my mind, I thought maybe copying both sets to
columns in a temporary location then use Union() in a third column in that
temporary location to "merge" the checkmarks, then copy that range to the
destination, then delete the temporary location, but that seems like a lot
to do to accomplish what should be easier. Besides, I can't come up with
the code to do that anyway.

Can anyone help me get all checkmarks from 2 sheets into my Destination?

--
David

Tom Ogilvy wrote

You leave out many important details such as where to place the second
set of data, what the sheet names are and so forth.

Final list to be a combined/merged list as opposed to continuous.

Column A contains names of people who attend program and may eat breakfast
and/or lunch or may not eat at all. Those who ate breafast have a checkmark
entered in a column under the current date to the right of their name.
Ditto for lunch. I want all who ate either meal to have their checkmarks
copied for the current date to the current date cells opposite their name
on the Attendance sheet. This is so after lunch the user will only have to
add checkmarks to the Attendance sheet for those that have not already been
accounted for when they ate.

We are a Title XX Food Program and totals for meals served and who ate them
are required to be reported monthly.

This was not a problem and my supplied code handled it nicely when we only
served lunch. Now we serve breakfast, too.

"Attendance" named-range common for all sheets to identify length of
row/col cell data to copy and also used to clear checkmarks in a routine
that empties range on each sheet and sets dates for the next month.

Sheets named as follows

Breakfast(1) Lunch(1) Attendance - checkmarks = X in this example
Name1 X X X
Name2 X X
Name3 X X
Name4 X 'added by user after lunch

--
David

Tom Ogilvy wrote

For the second range, I
have left in the Range("Attendance") part, but clearly that would not
correspond to the second set of data,

Well, when I choose "Attendance" from the Name box, the range for the
currently selected sheet is highlighted. IOW range depends on which sheet
I'm viewing even though "Attendance" is only listed once. So I think any
routine would grab the correct range for the referenced sheet.

--
David

Tom Ogilvy wrote

<snip

Ok, how 'bout this?

Here's the routine I use in both "meal" sheets to put the checkmark in the
desired cell in the first place:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [a3:a93]) Is Nothing Then Exit Sub
With Selection.Offset(0, Rows(2).Find(Date, LookIn:=xlFormulas).Column - 1)
.Value = Chr(252): .Font.Name = "Wingdings"
End With
End Sub

Is there some code I can add to put the checkmark into the corresponding
cell in the "Attendance" sheet at the same time? That would eliminate the
need for CopyToday().

--
David

David wrote

Is there some code I can add to put the checkmark into the
corresponding cell in the "Attendance" sheet at the same time? That
would eliminate the need for CopyToday().


Yipee!!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [a3:a93]) Is Nothing Then Exit Sub
With Selection.Offset(0, Rows(2).Find(Date).Column - 1)
.Value = Chr(252): .Font.Name = "Wingdings"
End With
Set srcaddress = Selection.Offset(0, Rows(2).Find(Date).Column - 1)
srcaddress.Copy Destination:=Sheets(3).Range(srcaddress.Address)
End Sub

--
David