N
Nicole Knapp
My project involves 4 scantron-like cards
Each card has 4 section to it. The first 3 sections are the same on each
card type
1st section - ID# and Date
2nd Section - Department (12 choices - none or multiple allowed)
3rd Section - Project Area (12 choices - none or multiple allowed)
4th Section - Attributes (From 13 to 19 choices - each with a 1, 2, 3 or
nothing allowed)
The software produces a worksheet for each card with ID#, Date, Each Dept,
Each Project, each Attribute as a header (so from column A to AA is filled
with the same headers on each sheet, Starting at AB, the headers differ
between sheets) The software records a "0" for each blank circle in sections
2, 3 & 4. A "1" for each filled circle in sections 2 & 3). The same person
can fill out multiple cards per day.
I have different reports that track this information for daily counts.
Counts by ID#, Counts per Date.
I have a VBA that splits out the attribute information by date
Attribute| Rating|1/27/2009|1/28/2009
Type A| 1| | |
2| 3| 7|
3| 2| 1|
Type B| 1| | |
2| 3| 7|
3| 1| |
Type C| 1| | |
2| 3| 4|
3| 2| 2|
Here is the code that was written for me:
Sub AttributeCount()
Sheet6.Select
lastrow_data = ActiveCell.SpecialCells(xlLastCell).Row
lastcol_data = ActiveCell.SpecialCells(xlLastCell).Column
Sheets("Attributes by Date").Select
lastcol = ActiveCell.SpecialCells(xlLastCell).Column
daterow = 2
Dim myattribs(1 To 13) As Integer
For i = 3 To lastcol ' dates going across
Sheets("Attributes by Date").Select
searchdate = Cells(2, i).Value
Sheet6.Select
For q = 2 To lastrow_data ' capture data
Sheet6.Select
testvalue = DateValue(Cells(q, 3).Text)
If testvalue = searchdate Then
For c = 1 To 13 ' columns 28 to 40
myattribs(c) = Cells(q, c + 27).Value
Next
Sheets("Attributes by Date").Select
Cells(3, i).Select
rownumber = 3
For t = 1 To 13
For b = 1 To 3
If myattribs(t) = b Then
Cells(rownumber, i).Value =
Cells(rownumber, i).Value + 1
End If
rownumber = rownumber + 1
Next
Next
End If
Next
Next
End Sub
My questions:
--Is there a quick way to change this code so that it looks for the ID#
within the data (down the column) and counts for it by date rather than for
the attribute (which is the header)? or some other way to count them up? (I
have the IDs in a list.)
--Is there a quick way to change this code so that it looks at the
department (or project) and counts up the attributes (1s, 2s, 3s) for each?
By date?
I have pivot tables doing a little bit of this, but they are very large.
The workbooks with this code in them are not as big.
So far I have 1900 ID#s (and a subset of 65 of those that I track for) and
over 1000 cards have been scanned.
Each card has 4 section to it. The first 3 sections are the same on each
card type
1st section - ID# and Date
2nd Section - Department (12 choices - none or multiple allowed)
3rd Section - Project Area (12 choices - none or multiple allowed)
4th Section - Attributes (From 13 to 19 choices - each with a 1, 2, 3 or
nothing allowed)
The software produces a worksheet for each card with ID#, Date, Each Dept,
Each Project, each Attribute as a header (so from column A to AA is filled
with the same headers on each sheet, Starting at AB, the headers differ
between sheets) The software records a "0" for each blank circle in sections
2, 3 & 4. A "1" for each filled circle in sections 2 & 3). The same person
can fill out multiple cards per day.
I have different reports that track this information for daily counts.
Counts by ID#, Counts per Date.
I have a VBA that splits out the attribute information by date
Attribute| Rating|1/27/2009|1/28/2009
Type A| 1| | |
2| 3| 7|
3| 2| 1|
Type B| 1| | |
2| 3| 7|
3| 1| |
Type C| 1| | |
2| 3| 4|
3| 2| 2|
Here is the code that was written for me:
Sub AttributeCount()
Sheet6.Select
lastrow_data = ActiveCell.SpecialCells(xlLastCell).Row
lastcol_data = ActiveCell.SpecialCells(xlLastCell).Column
Sheets("Attributes by Date").Select
lastcol = ActiveCell.SpecialCells(xlLastCell).Column
daterow = 2
Dim myattribs(1 To 13) As Integer
For i = 3 To lastcol ' dates going across
Sheets("Attributes by Date").Select
searchdate = Cells(2, i).Value
Sheet6.Select
For q = 2 To lastrow_data ' capture data
Sheet6.Select
testvalue = DateValue(Cells(q, 3).Text)
If testvalue = searchdate Then
For c = 1 To 13 ' columns 28 to 40
myattribs(c) = Cells(q, c + 27).Value
Next
Sheets("Attributes by Date").Select
Cells(3, i).Select
rownumber = 3
For t = 1 To 13
For b = 1 To 3
If myattribs(t) = b Then
Cells(rownumber, i).Value =
Cells(rownumber, i).Value + 1
End If
rownumber = rownumber + 1
Next
Next
End If
Next
Next
End Sub
My questions:
--Is there a quick way to change this code so that it looks for the ID#
within the data (down the column) and counts for it by date rather than for
the attribute (which is the header)? or some other way to count them up? (I
have the IDs in a list.)
--Is there a quick way to change this code so that it looks at the
department (or project) and counts up the attributes (1s, 2s, 3s) for each?
By date?
I have pivot tables doing a little bit of this, but they are very large.
The workbooks with this code in them are not as big.
So far I have 1900 ID#s (and a subset of 65 of those that I track for) and
over 1000 cards have been scanned.