Date Match Input Macro
 

Hi,

I have been working on this thing for the past couple of days not. Finally got somwhere with some help. Thanks. However, I am still not fully there. My problem lies as follows.

Sheet1
A B C

Row1 Date Cured Follow Up
Row2 1/2 2 1
Row3 1/3 3 2
Row4 1/4
Row5



Sheet2

Date: 1/4

Acct # Cured Follow Up
546 Y N
455 Y N
445 N N
775 Y Y

Totals: 3 1

When I run my macro it enters the data from the total line in sheet 2 in row 5 when I want the date entered into row 4 in column B. Second problem. Sheet 2 is my daily tabulation sheet. It changes daily, I have entered the "TODAY()" function so it can show the correct date always on sheet 2. Now, how can I have the "TODAY()" function match the date inputed in column A of sheet 1. What I would like is for Sheet 2 to recognize the date from sheet 1 and input the data into the corresponding row for that date. No luck yet in figuring that out. I need help! So if anyone can figure this out, that would be great. Here is the macro I am using thus far. It just inputs the data in the last totally blank row, which I do not want. Thanks again. Please help.


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Sub copy_1()
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Lr = LastRow(Sheets("Chambers")) + 1
Set sourceRange = Sheets("Sheet1").Range("d30:i30")
Set destrange = Sheets("Chambers").Range("d" & Lr)
sourceRange.Copy destrange
End Sub
Sub copy_1_Values_PasteSpecial()
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Application.ScreenUpdating = False
Lr = LastRow(Sheets("Chambers")) + 1
Set sourceRange = Sheets("Sheet1").Range("d30:i30")
Set destrange = Sheets("Chambers").Range("d" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Sub copy_1_Values_ValueProperty()
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Lr = LastRow(Sheets("Chambers")) + 1
Set sourceRange = Sheets("Sheet1").Range("d30:i30")
With sourceRange
Set destrange = Sheets("Chambers").Range("d" & Lr). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
End Sub