Try this in a
copy of your workbook.
If the sheet names or row/columns the data is in are different to mine, then code adjustments will be required. Note that I have removed some of the data from the 'Attendance Data' sheet for testing.
So, starting with these sheets and data ...
Excel Workbook |
---|
|
---|
| A | B | C | D | E | F | G | H | I |
---|
1 | Agent Name | 1-Aug | 2-Aug | 3-Aug | 4-Aug | 5-Aug | 6-Aug | 7-Aug | 8-Aug |
---|
2 | A | P | A | P | OH | P | P | P | A |
---|
3 | B | P | A | P | OH | P | P | P | A |
---|
4 | C | P | A | P | OH | P | P | P | P |
---|
5 | D | P | P | P | OH | P | P | P | P |
---|
6 | | | | | | | | | |
---|
|
---|
Excel Workbook |
---|
|
---|
| A | B |
---|
1 | Name | Date |
---|
2 | A | 1-Aug |
---|
3 | A | 3-Aug |
---|
4 | A | 5-Aug |
---|
5 | A | 6-Aug |
---|
6 | A | 7-Aug |
---|
7 | B | 1-Aug |
---|
8 | B | 3-Aug |
---|
9 | B | 5-Aug |
---|
10 | B | 6-Aug |
---|
11 | C | 1-Aug |
---|
12 | C | 3-Aug |
---|
13 | C | 5-Aug |
---|
14 | C | 6-Aug |
---|
15 | C | 7-Aug |
---|
16 | C | 8-Aug |
---|
17 | D | 1-Aug |
---|
18 | D | 3-Aug |
---|
19 | D | 5-Aug |
---|
20 | D | 6-Aug |
---|
21 | D | 7-Aug |
---|
22 | D | 8-Aug |
---|
23 | | |
---|
|
---|
... and running this code ...
<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> CheckAttendanceRecord()<br> <SPAN style="color:#00007F">Dim</SPAN> Att, Bprompt, Diff<br> <SPAN style="color:#00007F">Dim</SPAN> lrA <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, lcA <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, iA <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, jA <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br> <SPAN style="color:#00007F">Dim</SPAN> lrB <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, iB <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, nr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, k <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br> <SPAN style="color:#00007F">Dim</SPAN> Nm <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br> <SPAN style="color:#00007F">Dim</SPAN> D <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Date</SPAN><br> <SPAN style="color:#00007F">Dim</SPAN> bFound <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN><br> <br> <SPAN style="color:#00007F">With</SPAN> Sheets("Attendance Data")<br> lrA = .Cells(.Rows.Count, "A").End(xlUp).Row<br> lcA = .Cells(1, .Columns.Count).End(xlToLeft).Column<br> Att = .Range("A1").Resize(lrA, lcA).Value<br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br> <SPAN style="color:#00007F">With</SPAN> Sheets("Bprompt Data")<br> lrB = .Range("B" & .Rows.Count).End(xlUp).Row<br> Bprompt = .Range("A1:B" & lrB).Value<br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br> <SPAN style="color:#00007F">ReDim</SPAN> Diff(1 <SPAN style="color:#00007F">To</SPAN> lrA * lcA, 1 <SPAN style="color:#00007F">To</SPAN> 2)<br> <SPAN style="color:#00007F">For</SPAN> iA = 2 <SPAN style="color:#00007F">To</SPAN> lrA<br> <SPAN style="color:#00007F">For</SPAN> jA = 2 <SPAN style="color:#00007F">To</SPAN> lcA<br> <SPAN style="color:#00007F">If</SPAN> Att(iA, jA) = "P" <SPAN style="color:#00007F">Then</SPAN><br> Nm = Att(iA, 1)<br> D = Att(1, jA)<br> bFound = <SPAN style="color:#00007F">False</SPAN><br> iB = 1<br> <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">Until</SPAN> bFound <SPAN style="color:#00007F">Or</SPAN> iB = lrB<br> iB = iB + 1<br> <SPAN style="color:#00007F">If</SPAN> Bprompt(iB, 1) = Nm <SPAN style="color:#00007F">Then</SPAN><br> <SPAN style="color:#00007F">If</SPAN> Bprompt(iB, 2) = D <SPAN style="color:#00007F">Then</SPAN> bFound = <SPAN style="color:#00007F">True</SPAN><br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br> <SPAN style="color:#00007F">Loop</SPAN><br> <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> bFound <SPAN style="color:#00007F">Then</SPAN><br> k = k + 1<br> Diff(k, 1) = Nm<br> Diff(k, 2) = D<br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br> <SPAN style="color:#00007F">Next</SPAN> jA<br> <SPAN style="color:#00007F">Next</SPAN> iA<br> <SPAN style="color:#00007F">With</SPAN> Sheets("Difference")<br> nr = .Range("A" & .Rows.Count).End(xlUp).Row + 1<br> .Cells(nr, "A").Resize(lrA * lcA, 2).Value = Diff<br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>
... results in the following. I have assumed this 'Differences' sheet already exists and contains headings (and possibly some existing data) already.
Excel Workbook |
---|
|
---|
| A | B |
---|
1 | Name | Date |
---|
2 | B | 7-Aug |
---|
3 | D | 2-Aug |
---|
4 | | |
---|
|
---|