Help With Macro - Cannot figure out what I am doing wrong

[Dakota]

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.

 

[JLGWhiz]

What do you mean by "can't seem to get...to work? Is there an error
message, does it put data in the wrong place, does it not find the date????

 

[meh2030]

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

 

[Dakota]

Matt,

Sorry for not specifying what it is doing. When I run the macro, it runs
for only a split second and is done. No data is moved, no errors. All 5
other macros are running fine. This one compiles and comes back with no
syntax errors. It just wont pull the data.

I have also tied your code as well. It compiles and runs for a fraction of
a second and is done. Again, no data changed.

I just need to have Column A find a match in B2 on another sheet, Column B
find its matching date in A15:A45 on the same sheet, then have Column C's
variable copied to Column X of the row with the matching date.

I just do not know what I am missing to make this work.

 

[JLGWhiz]

Hi Dakota, I have added two message boxes to your code. Run the code and
note the message box results, if any. Post back with the what each message
box displays, or if it is blank. I suspect the second one will be blank,
but I could be wrong.

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
MsgBox fDate
cell.Offset(0, 2).Copy
Set c = sh.Range("A15:A45").Find(fDate, LookIn:=xlValues)
MsgBox c.Value
sh.Range("X" & c.Row).PasteSpecial xlPasteValues
End If
End If
Next
Next
End Sub

 

[meh2030]

Hi Dakota,  I have added two message boxes to your code.  Run the code and
note the message box results, if any.  Post back with the what each message
box displays, or if it is blank.  I suspect the second one will be blank,
but I could be wrong.

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
    MsgBox fDate
    cell.Offset(0, 2).Copy
      Set c = sh.Range("A15:A45").Find(fDate, LookIn:=xlValues)
           MsgBox c.Value
        sh.Range("X" & c.Row).PasteSpecial xlPasteValues
  End If
End If
Next
Next
End Sub

Dakota,

Try stepping through your program (F8 or Debug | Step Into) and/or
placing a breakpoint in your code (F9 or Debug | Toggle Breakpoint).
Step Into will allow you to evaluate the code one line at a time (just
keep pressing F8 to move to the next line). Breakpoint will pause
program execution at a specified line. By breaking execution and
stepping through your program, you can evaluate more closely how your
program is behaving. You should then be able to see where the code is
not executing as you see fit and troubleshoot from there.

Best,

Matt Herbert

 

[Dakota]

Matt & JLGWhiz,

Thank you for all your help, I added the message boxes and they did show
the correct data in each box and it did add the value to the correct field on
the correct worksheet on my test workbook.

I will apply this solution to my production workbook tonight and if having
difficulties apply Matt's recommendation of the step by step through the
program. I was not aware of this feature before your posting.

Thank you both for all your help!