If all cells match, copy down the date VBA

[Lenna]

I have to fill in report dates for tests. Each patient has multiple tests but “Report date” is only recoded for one of them. I’ve sorted the spreadsheet so that the row that contains the report date is first and all other tests in the same grouping are to follow.

I have a Single sheet that contains thousands of rows of continues data(no blank rows).

I need to match the content of each cell with a row below (columns A through I), to make sure that it’s the same grouping of test that was reported at the same time.
Only if all cells match( A through I), copy down the “Report date”. Repeat this until the end of data.

Please suggest some code.

ID	MRN	LastName	FirstName	Category	SampleDate	LogTime	AssignedDate	TestedDate	TestType	TestID	ReportDate
11111	222222222	Smith	Bob	Lung	1/24/2014	1/24/2014	1/24/2014	1/25/2014	S_A	1111	1/26/2014
11111	222222222	Smith	Bob	Lung	1/24/2014	1/24/2014	1/24/2014	1/25/2014	S_B	1112
11111	222222222	Smith	Bob	Lung	1/24/2014	1/24/2014	1/24/2014	1/25/2014	S_C	1113
11111	222222222	Smith	Bob	Lung	1/24/2014	1/24/2014	1/24/2014	1/25/2014	S_D	1114
11111	222222222	Smith	Bob	Lung	1/24/2014	1/24/2014	1/24/2014	1/26/2014	S_E	1114

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

Thanks

 

[jim may]

Make your cell L3 the activecell. With L3 active highlight L3:L6. in Cell L3 enter the "=" sign then with the Up Arrow point to cell L2. then Hold down the Control-Key and simultaneoulsly press the Enter Key. This should replicate a formula into all the highlighted cells. You can then Again select them all again (L3:L6) and Copy and Paste-Special Values to change the formulas to values.

 

[Lenna]

Would it work if I record it for a macro? I would prefer VBA code...I'm interested in learning what is actually happening...

Only columns A through F have to match…my apologies

Thank you very much,

Lenna

 

[Michael M]

Try... UNTESTED

Sub MM1()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = 2 To lr + 1
    If Range("A" & r).Value = Range("A" & r + 1).Value And _
        Range("B" & r).Value = Range("B" & r + 1).Value And _
        Range("C" & r).Value = Range("C" & r + 1).Value And _
        Range("D" & r).Value = Range("D" & r + 1).Value And _
        Range("E" & r).Value = Range("E" & r + 1).Value And _
        Range("F" & r).Value = Range("F" & r + 1).Value Then
        Range("L" & r + 1).Value = Range("L" & r).Value
    End If
    Next r
End Sub

 

[Lenna]

beautiful and simple
Thank you very much!

Lenna

Try... UNTESTED

Sub MM1()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = 2 To lr + 1
    If Range("A" & r).Value = Range("A" & r + 1).Value And _
        Range("B" & r).Value = Range("B" & r + 1).Value And _
        Range("C" & r).Value = Range("C" & r + 1).Value And _
        Range("D" & r).Value = Range("D" & r + 1).Value And _
        Range("E" & r).Value = Range("E" & r + 1).Value And _
        Range("F" & r).Value = Range("F" & r + 1).Value Then
        Range("L" & r + 1).Value = Range("L" & r).Value
    End If
    Next r
End Sub

 

[Michael M]

Glad it worked.....I'm sure there is a better way, but I didn't have Excel to play with it....:beerchug;