On Mar 24, 6:40*pm, Dakota wrote:
I have a worksheet that has 3 columns of data:

Column 1 - Names of People
Column 2 - Date (mm/dd/yyyy)
Column 3 - Time (hh:mm:ss)

Each name in column 1 corresponds to their own worksheet. *I am trying to
get Column 3 data to copy to the correct worksheet in the correct field after
matching the date in Column 2 to the same date in Column A in the persons
worksheet.

I have about 6 other macros running in this worksheet but cant seem to get
this one to work. *Below is the code I currently have built:

Sub Adherence()

Dim r As Range, cell As Range, sh As Worksheet
Dim lastrow As Long, c As Range, fDate As Date
With Worksheets("Adherence")
Set r = .Range(.Range("A1"), .Range("A1").End(xlDown))
End With
For Each cell In r
For Each sh In Worksheets
If LCase(sh.Name) < "adherence" Then
* If sh.Cells(2, "B").Value = cell Then
* * fDate = cell.Offset(0, 1).Value
* * cell.Offset(0, 2).Copy
* * * Set c = sh.Range("A15:A45").Find(fDate, LookIn:=xlValues)
* * * * sh.Range("X" & c.Row).PasteSpecial xlPasteValues
* End If
End If
Next
Next
End Sub

So to recap, I am matching the name in Column A on the 'Adherence' worksheet
to the name in B2 on the persons worksheet. *If match, then match Column B on
the 'Adherence' worksheet with the date in A15:A45 on the persons worksheet,
then copy Column C on the 'Adherence' worksheet to Column X on the persons
worksheet.

Any suggestions or if you can identify where my problem is, please let me
know.

Dakota,

Can you specify where you "can't seem to get this to work"? Are you
getting any error messages? I would venture a guess that you might
receive an error on "sh.Range("X" & c.Row..." periodically. If the
line of code preceeding this cannot find a match then "c" will be
Nothing. You are not testing for "c" being Nothing. I've included
some code below for your reference, but without any additional details
as to where you are running into a problem I can't be of much help.


Best,

Matt Herbert

Sub Adherence()

Dim rngData As Range
Dim rngCell As Range
Dim Wks As Worksheet
Dim lngLastRow As Long
Dim rngDateMatch As Range
Dim dateData As Date
Dim varDataValue As Variant

'set data to loop through
With Worksheets("Adherence")
Set rngData = .Range(.Range("A1"), .Range("A1").End(xlDown))
End With

'loop through each item in the data
For Each rngCell In rngData

'loop through each worksheet
For Each Wks In ActiveWorkbook.Worksheets

'make to not evaluate the "Adherence" worksheet
' make sure the "Adherence" name the cell name on another
' sheet
If LCase(Wks.Name) < "adherence" And Wks.Cells(2, "B").Value
= rngCell Then

'store date
dateData = rngCell.Offset(0, 1).Value

'store value
varDataValue = rngCell.Offset(0, 2).Value

'assumes only one match in the find range
Set rngDateMatch = Wks.Range("A15:A45").Find
(What:=dateData, _
After:=Range("a45"), LookIn:=xlValues,
_
LookAt:=xlPart, SearchOrder:=xlByRows)

'may not find a date match
If rngDateMatch Is Nothing Then
MsgBox "Didn't find date match for " & rngCell & "."
Else
'paste the value if the date from "Adherence" matches
' the date on the worksheet
Wks.Range("X" & rngDateMatch.Row).Value = varDataValue
End If

End If
Next
Next

End Sub