Hi,

I have a spreadsheet looks like this:

QID C1 C2 C3 C4 %a %b %c %d
13123 b b b b 0 100% 0% 0%
13124 d d d d 0% 0% 0% 100%
13125 d d d d 0% 0% 0% 100%


QID is the question ID and C1 to C4 are the answers by students. Column "%a"
is the percentage of "a" answered by students. I use countif function to
calculate that.

Everytime I copy and paste a group of answers the number of questions (
number of rows) and number of answers (number of columns) will be different.
Is there any macro that will calculate (%a, %b, %c and %d) and insert the
result in the first empty column?

Hope this is clear enough. Any answer will be appreciated!!

This is an interesting macro. It puts the countif function into yoiur
worksheet automatically. Just select the upper left hand cell in the range
of grades. The macro look for the first empty column and adds the number of
A's in the row (will vary depending on number of grades in the row). Then
moves over one row and does B's, then C's, and then D's. It repeats this for
all rows until it finds the first empty row.


Sub count_results()

Set topleft = ActiveCell
Lastrow = topleft.End(xlDown).Row
LastColumn = topleft.End(xlToRight).Column
ColumnA = LastColumn + 1
For RowCount = topleft.Row To Lastrow
For Columnoffset = 0 To 3
Select Case Columnoffset
Case 0
Grade = """A"""
Case 1
Grade = """B"""
Case 2
Grade = """C"""
Case 3
Grade = """D"""
End Select
Formula = "=Countif(R" & RowCount & "C" & topleft.Column & _
":R" & RowCount & "C" & LastColumn & "," & Grade & ")"
Cells(RowCount, ColumnA + Columnoffset).FormulaR1C1 = Formula
Next Columnoffset
Next RowCount
End Sub

"tomaski" wrote:

> Hi,
>
> I have a spreadsheet looks like this:
>
> QID C1 C2 C3 C4 %a %b %c %d
> 13123 b b b b 0 100% 0% 0%
> 13124 d d d d 0% 0% 0% 100%
> 13125 d d d d 0% 0% 0% 100%
>
>
> QID is the question ID and C1 to C4 are the answers by students. Column "%a"
> is the percentage of "a" answered by students. I use countif function to
> calculate that.
>
> Everytime I copy and paste a group of answers the number of questions (
> number of rows) and number of answers (number of columns) will be different.
> Is there any macro that will calculate (%a, %b, %c and %d) and insert the
> result in the first empty column?
>
> Hope this is clear enough. Any answer will be appreciated!!
>

"Is there any macro...?" There is now!

The macro below will do what you want. You could even expand it later to
permit more answer options - it's set for 4 options now in array
possibleAnswers().

Press [Alt]+[F11] to open the VB Editor, choose Insert | Module and copy and
paste the code into the module presented. Choose the sheet with the student
answer entries in it, and use Tools | Macro | Macros to run the macro. It
presumes that NO percentages have been calculated for any row when you run it.
Also presumes that QID is in column A and all that follow it on a row are
answers entered by students when it begins.

Sub CalcResults()
'must start with QID and answer inputs ONLY
'you'll need to clear any previous entries
'on ALL rows before using this
'
'you must have the data sheet selected
'before running this Macro
'
Const firstAnswerRow = 2 ' first row # with question data
Dim possibleAnswers(1 To 4) As String
Dim resultsChosenCounts() As Long
Dim lastRow As Long
Dim lastCol As Long
Dim maxColumns As Long
Dim baseCell As Range
Dim rOffset As Long
Dim cOffset As Long
Dim numEntries As Long
Dim selectionCount As Long
Dim ALC As Integer ' array loop counter

'initialize possibleAnswers() array
possibleAnswers(1) = "a" ' case is not important
possibleAnswers(2) = "b"
possibleAnswers(3) = "c"
possibleAnswers(4) = "d"
ReDim resultsChosenCounts(LBound(possibleAnswers) To _
UBound(possibleAnswers)) ' dimensions must match
If Val(Left(Application.Version, 2)) < 12 Then
'in Excel 2003 or earlier
lastRow = Range("A" & Rows.Count).End(xlUp).Row
maxColumns = Columns.Count
Else
'in Excel 2007 (or later)
lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
maxColumns = Columns.Count
End If
If lastRow < firstAnswerRow Then
Exit Sub ' no question data entered
End If
Set baseCell = ActiveSheet.Range("A" & firstAnswerRow)
'start looping through used rows
Do Until rOffset + baseCell.Row > lastRow
lastCol = baseCell.Offset(rOffset, 0).End(xlToRight).Column
numEntries = lastCol - 1 ' assumes all are question results
If lastCol > (maxColumns - UBound(resultsChosenCounts)) Then
MsgBox "Not Enough Columns to Present all Results.", _
vbOKOnly, "Aborting"
Set baseCell = Nothing
Exit Sub
End If
'reset/initialize
selectionCount = 0
cOffset = 1 ' start looking in Col B
For ALC = LBound(resultsChosenCounts) To _
UBound(resultsChosenCounts)
resultsChosenCounts(ALC) = 0 ' reset
Next
For ALC = LBound(possibleAnswers) To UBound(possibleAnswers)
For cOffset = 1 To lastCol - 1
If UCase(Trim(baseCell.Offset(rOffset, cOffset))) = _
UCase(Trim(possibleAnswers(ALC))) Then
resultsChosenCounts(ALC) = resultsChosenCounts(ALC) + 1
End If
Next
Next ' end ALC loop
For ALC = LBound(resultsChosenCounts) To _
UBound(resultsChosenCounts)
baseCell.Offset(rOffset, (lastCol - 1) + ALC) = _
resultsChosenCounts(ALC) / numEntries
baseCell.Offset(rOffset, (lastCol - 1) + ALC).Style = _
"Percent"
Next ' end ALC output loop
rOffset = rOffset + 1 ' move to next row
Loop ' row loop
End Sub



"tomaski" wrote:

> Hi,
>
> I have a spreadsheet looks like this:
>
> QID C1 C2 C3 C4 %a %b %c %d
> 13123 b b b b 0 100% 0% 0%
> 13124 d d d d 0% 0% 0% 100%
> 13125 d d d d 0% 0% 0% 100%
>
>
> QID is the question ID and C1 to C4 are the answers by students. Column "%a"
> is the percentage of "a" answered by students. I use countif function to
> calculate that.
>
> Everytime I copy and paste a group of answers the number of questions (
> number of rows) and number of answers (number of columns) will be different.
> Is there any macro that will calculate (%a, %b, %c and %d) and insert the
> result in the first empty column?
>
> Hope this is clear enough. Any answer will be appreciated!!
>

On Nov 6, 12:09 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
wrote:
> "Is there any macro...?" There is now!
>
> The macro below will do what you want. You could even expand it later to
> permit more answer options - it's set for 4 options now in array
> possibleAnswers().
>
> Press [Alt]+[F11] to open the VB Editor, choose Insert | Module and copy and
> paste the code into the module presented. Choose the sheet with the student
> answer entries in it, and use Tools | Macro | Macros to run the macro. It
> presumes that NO percentages have been calculated for any row when you run it.
> Also presumes that QID is in column A and all that follow it on a row are
> answers entered by students when it begins.
>
> Sub CalcResults()
> 'must start with QID and answer inputs ONLY
> 'you'll need to clear any previous entries
> 'on ALL rows before using this
> '
> 'you must have the data sheet selected
> 'before running this Macro
> '
> Const firstAnswerRow = 2 ' first row # with question data
> Dim possibleAnswers(1 To 4) As String
> Dim resultsChosenCounts() As Long
> Dim lastRow As Long
> Dim lastCol As Long
> Dim maxColumns As Long
> Dim baseCell As Range
> Dim rOffset As Long
> Dim cOffset As Long
> Dim numEntries As Long
> Dim selectionCount As Long
> Dim ALC As Integer ' array loop counter
>
> 'initialize possibleAnswers() array
> possibleAnswers(1) = "a" ' case is not important
> possibleAnswers(2) = "b"
> possibleAnswers(3) = "c"
> possibleAnswers(4) = "d"
> ReDim resultsChosenCounts(LBound(possibleAnswers) To _
> UBound(possibleAnswers)) ' dimensions must match
> If Val(Left(Application.Version, 2)) < 12 Then
> 'in Excel 2003 or earlier
> lastRow = Range("A" & Rows.Count).End(xlUp).Row
> maxColumns = Columns.Count
> Else
> 'in Excel 2007 (or later)
> lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
> maxColumns = Columns.Count
> End If
> If lastRow < firstAnswerRow Then
> Exit Sub ' no question data entered
> End If
> Set baseCell = ActiveSheet.Range("A" & firstAnswerRow)
> 'start looping through used rows
> Do Until rOffset + baseCell.Row > lastRow
> lastCol = baseCell.Offset(rOffset, 0).End(xlToRight).Column
> numEntries = lastCol - 1 ' assumes all are question results
> If lastCol > (maxColumns - UBound(resultsChosenCounts)) Then
> MsgBox "Not Enough Columns to Present all Results.", _
> vbOKOnly, "Aborting"
> Set baseCell = Nothing
> Exit Sub
> End If
> 'reset/initialize
> selectionCount = 0
> cOffset = 1 ' start looking in Col B
> For ALC = LBound(resultsChosenCounts) To _
> UBound(resultsChosenCounts)
> resultsChosenCounts(ALC) = 0 ' reset
> Next
> For ALC = LBound(possibleAnswers) To UBound(possibleAnswers)
> For cOffset = 1 To lastCol - 1
> If UCase(Trim(baseCell.Offset(rOffset, cOffset))) = _
> UCase(Trim(possibleAnswers(ALC))) Then
> resultsChosenCounts(ALC) = resultsChosenCounts(ALC) + 1
> End If
> Next
> Next ' end ALC loop
> For ALC = LBound(resultsChosenCounts) To _
> UBound(resultsChosenCounts)
> baseCell.Offset(rOffset, (lastCol - 1) + ALC) = _
> resultsChosenCounts(ALC) / numEntries
> baseCell.Offset(rOffset, (lastCol - 1) + ALC).Style = _
> "Percent"
> Next ' end ALC output loop
> rOffset = rOffset + 1 ' move to next row
> Loop ' row loop
> End Sub
>
> "tomaski" wrote:
> > Hi,
>
> > I have a spreadsheet looks like this:
>
> > QID C1 C2 C3 C4 %a %b %c %d
> > 13123 b b b b 0 100% 0% 0%
> > 13124 d d d d 0% 0% 0% 100%
> > 13125 d d d d 0% 0% 0% 100%
>
> > QID is the question ID and C1 to C4 are the answers by students. Column "%a"
> > is the percentage of "a" answered by students. I use countif function to
> > calculate that.
>
> > Everytime I copy and paste a group of answers the number of questions (
> > number of rows) and number of answers (number of columns) will be different.
> > Is there any macro that will calculate (%a, %b, %c and %d) and insert the
> > result in the first empty column?
>
> > Hope this is clear enough. Any answer will be appreciated!!

Thanks so much for your reply!!!! That is really a lifesaver!!!!

The code will calculate only if answers are filled. Is there anyway to
perform more accurate calculation if some answers are left blank?

Once again, thanks for your prompt reply!!!!!

Should not be too difficult to change the code to do that - I presume that
you mean a situation like this (for first row of 'b's) that if it were b b
b then total answers would be 3 vs 4? To expand further, then if inputs were
a b c the results would be:
%a = 33.33% %b = 33.33% %c = 33.33% %d = 0%


"(E-Mail Removed)" wrote:

> On Nov 6, 12:09 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
> wrote:
> > "Is there any macro...?" There is now!
> >
> > The macro below will do what you want. You could even expand it later to
> > permit more answer options - it's set for 4 options now in array
> > possibleAnswers().
> >
> > Press [Alt]+[F11] to open the VB Editor, choose Insert | Module and copy and
> > paste the code into the module presented. Choose the sheet with the student
> > answer entries in it, and use Tools | Macro | Macros to run the macro. It
> > presumes that NO percentages have been calculated for any row when you run it.
> > Also presumes that QID is in column A and all that follow it on a row are
> > answers entered by students when it begins.
> >
> > Sub CalcResults()
> > 'must start with QID and answer inputs ONLY
> > 'you'll need to clear any previous entries
> > 'on ALL rows before using this
> > '
> > 'you must have the data sheet selected
> > 'before running this Macro
> > '
> > Const firstAnswerRow = 2 ' first row # with question data
> > Dim possibleAnswers(1 To 4) As String
> > Dim resultsChosenCounts() As Long
> > Dim lastRow As Long
> > Dim lastCol As Long
> > Dim maxColumns As Long
> > Dim baseCell As Range
> > Dim rOffset As Long
> > Dim cOffset As Long
> > Dim numEntries As Long
> > Dim selectionCount As Long
> > Dim ALC As Integer ' array loop counter
> >
> > 'initialize possibleAnswers() array
> > possibleAnswers(1) = "a" ' case is not important
> > possibleAnswers(2) = "b"
> > possibleAnswers(3) = "c"
> > possibleAnswers(4) = "d"
> > ReDim resultsChosenCounts(LBound(possibleAnswers) To _
> > UBound(possibleAnswers)) ' dimensions must match
> > If Val(Left(Application.Version, 2)) < 12 Then
> > 'in Excel 2003 or earlier
> > lastRow = Range("A" & Rows.Count).End(xlUp).Row
> > maxColumns = Columns.Count
> > Else
> > 'in Excel 2007 (or later)
> > lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
> > maxColumns = Columns.Count
> > End If
> > If lastRow < firstAnswerRow Then
> > Exit Sub ' no question data entered
> > End If
> > Set baseCell = ActiveSheet.Range("A" & firstAnswerRow)
> > 'start looping through used rows
> > Do Until rOffset + baseCell.Row > lastRow
> > lastCol = baseCell.Offset(rOffset, 0).End(xlToRight).Column
> > numEntries = lastCol - 1 ' assumes all are question results
> > If lastCol > (maxColumns - UBound(resultsChosenCounts)) Then
> > MsgBox "Not Enough Columns to Present all Results.", _
> > vbOKOnly, "Aborting"
> > Set baseCell = Nothing
> > Exit Sub
> > End If
> > 'reset/initialize
> > selectionCount = 0
> > cOffset = 1 ' start looking in Col B
> > For ALC = LBound(resultsChosenCounts) To _
> > UBound(resultsChosenCounts)
> > resultsChosenCounts(ALC) = 0 ' reset
> > Next
> > For ALC = LBound(possibleAnswers) To UBound(possibleAnswers)
> > For cOffset = 1 To lastCol - 1
> > If UCase(Trim(baseCell.Offset(rOffset, cOffset))) = _
> > UCase(Trim(possibleAnswers(ALC))) Then
> > resultsChosenCounts(ALC) = resultsChosenCounts(ALC) + 1
> > End If
> > Next
> > Next ' end ALC loop
> > For ALC = LBound(resultsChosenCounts) To _
> > UBound(resultsChosenCounts)
> > baseCell.Offset(rOffset, (lastCol - 1) + ALC) = _
> > resultsChosenCounts(ALC) / numEntries
> > baseCell.Offset(rOffset, (lastCol - 1) + ALC).Style = _
> > "Percent"
> > Next ' end ALC output loop
> > rOffset = rOffset + 1 ' move to next row
> > Loop ' row loop
> > End Sub
> >
> > "tomaski" wrote:
> > > Hi,
> >
> > > I have a spreadsheet looks like this:
> >
> > > QID C1 C2 C3 C4 %a %b %c %d
> > > 13123 b b b b 0 100% 0% 0%
> > > 13124 d d d d 0% 0% 0% 100%
> > > 13125 d d d d 0% 0% 0% 100%
> >
> > > QID is the question ID and C1 to C4 are the answers by students. Column "%a"
> > > is the percentage of "a" answered by students. I use countif function to
> > > calculate that.
> >
> > > Everytime I copy and paste a group of answers the number of questions (
> > > number of rows) and number of answers (number of columns) will be different.
> > > Is there any macro that will calculate (%a, %b, %c and %d) and insert the
> > > result in the first empty column?
> >
> > > Hope this is clear enough. Any answer will be appreciated!!
>
> Thanks so much for your reply!!!! That is really a lifesaver!!!!
>
> The code will calculate only if answers are filled. Is there anyway to
> perform more accurate calculation if some answers are left blank?
>
> Once again, thanks for your prompt reply!!!!!
>
>

On Nov 7, 5:18 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
wrote:
> Should not be too difficult to change the code to do that - I presume that
> you mean a situation like this (for first row of 'b's) that if it were b b
> b then total answers would be 3 vs 4? To expand further, then if inputs were
> a b c the results would be:
> %a = 33.33% %b = 33.33% %c = 33.33% %d = 0%
>
> "rogerchengn...@gmail.com" wrote:
> > On Nov 6, 12:09 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
> > wrote:
> > > "Is there any macro...?" There is now!
>
> > > The macro below will do what you want. You could even expand it later to
> > > permit more answer options - it's set for 4 options now in array
> > > possibleAnswers().
>
> > > Press [Alt]+[F11] to open the VB Editor, choose Insert | Module and copy and
> > > paste the code into the module presented. Choose the sheet with the student
> > > answer entries in it, and use Tools | Macro | Macros to run the macro. It
> > > presumes that NO percentages have been calculated for any row when you run it.
> > > Also presumes that QID is in column A and all that follow it on a row are
> > > answers entered by students when it begins.
>
> > > Sub CalcResults()
> > > 'must start with QID and answer inputs ONLY
> > > 'you'll need to clear any previous entries
> > > 'on ALL rows before using this
> > > '
> > > 'you must have the data sheet selected
> > > 'before running this Macro
> > > '
> > > Const firstAnswerRow = 2 ' first row # with question data
> > > Dim possibleAnswers(1 To 4) As String
> > > Dim resultsChosenCounts() As Long
> > > Dim lastRow As Long
> > > Dim lastCol As Long
> > > Dim maxColumns As Long
> > > Dim baseCell As Range
> > > Dim rOffset As Long
> > > Dim cOffset As Long
> > > Dim numEntries As Long
> > > Dim selectionCount As Long
> > > Dim ALC As Integer ' array loop counter
>
> > > 'initialize possibleAnswers() array
> > > possibleAnswers(1) = "a" ' case is not important
> > > possibleAnswers(2) = "b"
> > > possibleAnswers(3) = "c"
> > > possibleAnswers(4) = "d"
> > > ReDim resultsChosenCounts(LBound(possibleAnswers) To _
> > > UBound(possibleAnswers)) ' dimensions must match
> > > If Val(Left(Application.Version, 2)) < 12 Then
> > > 'in Excel 2003 or earlier
> > > lastRow = Range("A" & Rows.Count).End(xlUp).Row
> > > maxColumns = Columns.Count
> > > Else
> > > 'in Excel 2007 (or later)
> > > lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
> > > maxColumns = Columns.Count
> > > End If
> > > If lastRow < firstAnswerRow Then
> > > Exit Sub ' no question data entered
> > > End If
> > > Set baseCell = ActiveSheet.Range("A" & firstAnswerRow)
> > > 'start looping through used rows
> > > Do Until rOffset + baseCell.Row > lastRow
> > > lastCol = baseCell.Offset(rOffset, 0).End(xlToRight).Column
> > > numEntries = lastCol - 1 ' assumes all are question results
> > > If lastCol > (maxColumns - UBound(resultsChosenCounts)) Then
> > > MsgBox "Not Enough Columns to Present all Results.", _
> > > vbOKOnly, "Aborting"
> > > Set baseCell = Nothing
> > > Exit Sub
> > > End If
> > > 'reset/initialize
> > > selectionCount = 0
> > > cOffset = 1 ' start looking in Col B
> > > For ALC = LBound(resultsChosenCounts) To _
> > > UBound(resultsChosenCounts)
> > > resultsChosenCounts(ALC) = 0 ' reset
> > > Next
> > > For ALC = LBound(possibleAnswers) To UBound(possibleAnswers)
> > > For cOffset = 1 To lastCol - 1
> > > If UCase(Trim(baseCell.Offset(rOffset, cOffset))) = _
> > > UCase(Trim(possibleAnswers(ALC))) Then
> > > resultsChosenCounts(ALC) = resultsChosenCounts(ALC) + 1
> > > End If
> > > Next
> > > Next ' end ALC loop
> > > For ALC = LBound(resultsChosenCounts) To _
> > > UBound(resultsChosenCounts)
> > > baseCell.Offset(rOffset, (lastCol - 1) + ALC) = _
> > > resultsChosenCounts(ALC) / numEntries
> > > baseCell.Offset(rOffset, (lastCol - 1) + ALC).Style = _
> > > "Percent"
> > > Next ' end ALC output loop
> > > rOffset = rOffset + 1 ' move to next row
> > > Loop ' row loop
> > > End Sub
>
> > > "tomaski" wrote:
> > > > Hi,
>
> > > > I have a spreadsheet looks like this:
>
> > > > QID C1 C2 C3 C4 %a %b %c %d
> > > > 13123 b b b b 0 100% 0% 0%
> > > > 13124 d d d d 0% 0% 0% 100%
> > > > 13125 d d d d 0% 0% 0% 100%
>
> > > > QID is the question ID and C1 to C4 are the answers by students. Column "%a"
> > > > is the percentage of "a" answered by students. I use countif function to
> > > > calculate that.
>
> > > > Everytime I copy and paste a group of answers the number of questions (
> > > > number of rows) and number of answers (number of columns) will be different.
> > > > Is there any macro that will calculate (%a, %b, %c and %d) and insert the
> > > > result in the first empty column?
>
> > > > Hope this is clear enough. Any answer will be appreciated!!
>
> > Thanks so much for your reply!!!! That is really a lifesaver!!!!
>
> > The code will calculate only if answers are filled. Is there anyway to
> > perform more accurate calculation if some answers are left blank?
>
> > Once again, thanks for your prompt reply!!!!!

Yes. That's exactly what I meant.
Thanks for your neat code!!!

In that case, these modifications in the way we find the last used column
(looking from right edge of sheet back to the left) and the way we count
entries found will do the calculations the way you want:

Sub CalcResults()
'must start with QID and answer inputs ONLY
'you'll need to clear any previous entries
'on ALL rows before using this
'
'you must have the data sheet selected
'before running this Macro
'
Const firstAnswerRow = 2 ' first row # with question data
Dim possibleAnswers(1 To 4) As String
Dim resultsChosenCounts() As Long
Dim lastRow As Long
Dim lastCol As Long
Dim maxColumns As Long
Dim baseCell As Range
Dim rOffset As Long
Dim cOffset As Long
Dim numEntries As Long
Dim selectionCount As Long
Dim ALC As Integer ' array loop counter

'initialize possibleAnswers() array
possibleAnswers(1) = "a" ' case is not important
possibleAnswers(2) = "b"
possibleAnswers(3) = "c"
possibleAnswers(4) = "d"
ReDim resultsChosenCounts(LBound(possibleAnswers) To _
UBound(possibleAnswers)) ' dimensions must match
If Val(Left(Application.Version, 2)) < 12 Then
'in Excel 2003 or earlier
lastRow = Range("A" & Rows.Count).End(xlUp).Row
maxColumns = Columns.Count
Else
'in Excel 2007 (or later)
lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
maxColumns = Columns.Count
End If
If lastRow < firstAnswerRow Then
Exit Sub ' no question data entered
End If
Set baseCell = ActiveSheet.Range("A" & firstAnswerRow)
'start looping through used rows
Do Until rOffset + baseCell.Row > lastRow
numEntries = 0 ' initialize/reset
lastCol = baseCell.Offset(rOffset, Columns.Count -
baseCell.Column).End(xlToLeft).Column
If lastCol > (maxColumns - UBound(resultsChosenCounts)) Then
MsgBox "Not Enough Columns to Present all Results.", _
vbOKOnly, "Aborting"
Set baseCell = Nothing
Exit Sub
End If
'reset/initialize
selectionCount = 0
cOffset = 1 ' start looking in Col B
For ALC = LBound(resultsChosenCounts) To _
UBound(resultsChosenCounts)
resultsChosenCounts(ALC) = 0 ' reset
Next
For ALC = LBound(possibleAnswers) To UBound(possibleAnswers)
For cOffset = 1 To lastCol - 1
If UCase(Trim(baseCell.Offset(rOffset, cOffset))) = _
UCase(Trim(possibleAnswers(ALC))) Then
resultsChosenCounts(ALC) = resultsChosenCounts(ALC) + 1
numEntries = numEntries + 1
End If
Next
Next ' end ALC loop
For ALC = LBound(resultsChosenCounts) To _
UBound(resultsChosenCounts)
baseCell.Offset(rOffset, (lastCol - 1) + ALC) = _
resultsChosenCounts(ALC) / numEntries
baseCell.Offset(rOffset, (lastCol - 1) + ALC).Style = _
"Percent"
Next ' end ALC output loop
rOffset = rOffset + 1 ' move to next row
Loop ' row loop
End Sub



"(E-Mail Removed)" wrote:

> On Nov 7, 5:18 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
> wrote:
> > Should not be too difficult to change the code to do that - I presume that
> > you mean a situation like this (for first row of 'b's) that if it were b b
> > b then total answers would be 3 vs 4? To expand further, then if inputs were
> > a b c the results would be:
> > %a = 33.33% %b = 33.33% %c = 33.33% %d = 0%
> >
> > "rogerchengn...@gmail.com" wrote:
> > > On Nov 6, 12:09 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
> > > wrote:
> > > > "Is there any macro...?" There is now!
> >
> > > > The macro below will do what you want. You could even expand it later to
> > > > permit more answer options - it's set for 4 options now in array
> > > > possibleAnswers().
> >
> > > > Press [Alt]+[F11] to open the VB Editor, choose Insert | Module and copy and
> > > > paste the code into the module presented. Choose the sheet with the student
> > > > answer entries in it, and use Tools | Macro | Macros to run the macro. It
> > > > presumes that NO percentages have been calculated for any row when you run it.
> > > > Also presumes that QID is in column A and all that follow it on a row are
> > > > answers entered by students when it begins.
> >
> > > > Sub CalcResults()
> > > > 'must start with QID and answer inputs ONLY
> > > > 'you'll need to clear any previous entries
> > > > 'on ALL rows before using this
> > > > '
> > > > 'you must have the data sheet selected
> > > > 'before running this Macro
> > > > '
> > > > Const firstAnswerRow = 2 ' first row # with question data
> > > > Dim possibleAnswers(1 To 4) As String
> > > > Dim resultsChosenCounts() As Long
> > > > Dim lastRow As Long
> > > > Dim lastCol As Long
> > > > Dim maxColumns As Long
> > > > Dim baseCell As Range
> > > > Dim rOffset As Long
> > > > Dim cOffset As Long
> > > > Dim numEntries As Long
> > > > Dim selectionCount As Long
> > > > Dim ALC As Integer ' array loop counter
> >
> > > > 'initialize possibleAnswers() array
> > > > possibleAnswers(1) = "a" ' case is not important
> > > > possibleAnswers(2) = "b"
> > > > possibleAnswers(3) = "c"
> > > > possibleAnswers(4) = "d"
> > > > ReDim resultsChosenCounts(LBound(possibleAnswers) To _
> > > > UBound(possibleAnswers)) ' dimensions must match
> > > > If Val(Left(Application.Version, 2)) < 12 Then
> > > > 'in Excel 2003 or earlier
> > > > lastRow = Range("A" & Rows.Count).End(xlUp).Row
> > > > maxColumns = Columns.Count
> > > > Else
> > > > 'in Excel 2007 (or later)
> > > > lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
> > > > maxColumns = Columns.Count
> > > > End If
> > > > If lastRow < firstAnswerRow Then
> > > > Exit Sub ' no question data entered
> > > > End If
> > > > Set baseCell = ActiveSheet.Range("A" & firstAnswerRow)
> > > > 'start looping through used rows
> > > > Do Until rOffset + baseCell.Row > lastRow
> > > > lastCol = baseCell.Offset(rOffset, 0).End(xlToRight).Column
> > > > numEntries = lastCol - 1 ' assumes all are question results
> > > > If lastCol > (maxColumns - UBound(resultsChosenCounts)) Then
> > > > MsgBox "Not Enough Columns to Present all Results.", _
> > > > vbOKOnly, "Aborting"
> > > > Set baseCell = Nothing
> > > > Exit Sub
> > > > End If
> > > > 'reset/initialize
> > > > selectionCount = 0
> > > > cOffset = 1 ' start looking in Col B
> > > > For ALC = LBound(resultsChosenCounts) To _
> > > > UBound(resultsChosenCounts)
> > > > resultsChosenCounts(ALC) = 0 ' reset
> > > > Next
> > > > For ALC = LBound(possibleAnswers) To UBound(possibleAnswers)
> > > > For cOffset = 1 To lastCol - 1
> > > > If UCase(Trim(baseCell.Offset(rOffset, cOffset))) = _
> > > > UCase(Trim(possibleAnswers(ALC))) Then
> > > > resultsChosenCounts(ALC) = resultsChosenCounts(ALC) + 1
> > > > End If
> > > > Next
> > > > Next ' end ALC loop
> > > > For ALC = LBound(resultsChosenCounts) To _
> > > > UBound(resultsChosenCounts)
> > > > baseCell.Offset(rOffset, (lastCol - 1) + ALC) = _
> > > > resultsChosenCounts(ALC) / numEntries
> > > > baseCell.Offset(rOffset, (lastCol - 1) + ALC).Style = _
> > > > "Percent"
> > > > Next ' end ALC output loop
> > > > rOffset = rOffset + 1 ' move to next row
> > > > Loop ' row loop
> > > > End Sub
> >
> > > > "tomaski" wrote:
> > > > > Hi,
> >
> > > > > I have a spreadsheet looks like this:
> >
> > > > > QID C1 C2 C3 C4 %a %b %c %d
> > > > > 13123 b b b b 0 100% 0% 0%
> > > > > 13124 d d d d 0% 0% 0% 100%
> > > > > 13125 d d d d 0% 0% 0% 100%
> >
> > > > > QID is the question ID and C1 to C4 are the answers by students. Column "%a"
> > > > > is the percentage of "a" answered by students. I use countif function to
> > > > > calculate that.
> >
> > > > > Everytime I copy and paste a group of answers the number of questions (
> > > > > number of rows) and number of answers (number of columns) will be different.
> > > > > Is there any macro that will calculate (%a, %b, %c and %d) and insert the
> > > > > result in the first empty column?
> >
> > > > > Hope this is clear enough. Any answer will be appreciated!!
> >
> > > Thanks so much for your reply!!!! That is really a lifesaver!!!!
> >
> > > The code will calculate only if answers are filled. Is there anyway to
> > > perform more accurate calculation if some answers are left blank?
> >
> > > Once again, thanks for your prompt reply!!!!!
>
> Yes. That's exactly what I meant.
> Thanks for your neat code!!!
>
>

On Nov 7, 9:12 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
wrote:
> In that case, these modifications in the way we find the last used column
> (looking from right edge of sheet back to the left) and the way we count
> entries found will do the calculations the way you want:
>
> Sub CalcResults()
> 'must start with QID and answer inputs ONLY
> 'you'll need to clear any previous entries
> 'on ALL rows before using this
> '
> 'you must have the data sheet selected
> 'before running this Macro
> '
> Const firstAnswerRow = 2 ' first row # with question data
> Dim possibleAnswers(1 To 4) As String
> Dim resultsChosenCounts() As Long
> Dim lastRow As Long
> Dim lastCol As Long
> Dim maxColumns As Long
> Dim baseCell As Range
> Dim rOffset As Long
> Dim cOffset As Long
> Dim numEntries As Long
> Dim selectionCount As Long
> Dim ALC As Integer ' array loop counter
>
> 'initialize possibleAnswers() array
> possibleAnswers(1) = "a" ' case is not important
> possibleAnswers(2) = "b"
> possibleAnswers(3) = "c"
> possibleAnswers(4) = "d"
> ReDim resultsChosenCounts(LBound(possibleAnswers) To _
> UBound(possibleAnswers)) ' dimensions must match
> If Val(Left(Application.Version, 2)) < 12 Then
> 'in Excel 2003 or earlier
> lastRow = Range("A" & Rows.Count).End(xlUp).Row
> maxColumns = Columns.Count
> Else
> 'in Excel 2007 (or later)
> lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
> maxColumns = Columns.Count
> End If
> If lastRow < firstAnswerRow Then
> Exit Sub ' no question data entered
> End If
> Set baseCell = ActiveSheet.Range("A" & firstAnswerRow)
> 'start looping through used rows
> Do Until rOffset + baseCell.Row > lastRow
> numEntries = 0 ' initialize/reset
> lastCol = baseCell.Offset(rOffset, Columns.Count -
> baseCell.Column).End(xlToLeft).Column
> If lastCol > (maxColumns - UBound(resultsChosenCounts)) Then
> MsgBox "Not Enough Columns to Present all Results.", _
> vbOKOnly, "Aborting"
> Set baseCell = Nothing
> Exit Sub
> End If
> 'reset/initialize
> selectionCount = 0
> cOffset = 1 ' start looking in Col B
> For ALC = LBound(resultsChosenCounts) To _
> UBound(resultsChosenCounts)
> resultsChosenCounts(ALC) = 0 ' reset
> Next
> For ALC = LBound(possibleAnswers) To UBound(possibleAnswers)
> For cOffset = 1 To lastCol - 1
> If UCase(Trim(baseCell.Offset(rOffset, cOffset))) = _
> UCase(Trim(possibleAnswers(ALC))) Then
> resultsChosenCounts(ALC) = resultsChosenCounts(ALC) + 1
> numEntries = numEntries + 1
> End If
> Next
> Next ' end ALC loop
> For ALC = LBound(resultsChosenCounts) To _
> UBound(resultsChosenCounts)
> baseCell.Offset(rOffset, (lastCol - 1) + ALC) = _
> resultsChosenCounts(ALC) / numEntries
> baseCell.Offset(rOffset, (lastCol - 1) + ALC).Style = _
> "Percent"
> Next ' end ALC output loop
> rOffset = rOffset + 1 ' move to next row
> Loop ' row loop
> End Sub
>
> "rogerchengn...@gmail.com" wrote:
> > On Nov 7, 5:18 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
> > wrote:
> > > Should not be too difficult to change the code to do that - I presume that
> > > you mean a situation like this (for first row of 'b's) that if it were b b
> > > b then total answers would be 3 vs 4? To expand further, then if inputs were
> > > a b c the results would be:
> > > %a = 33.33% %b = 33.33% %c = 33.33% %d = 0%
>
> > > "rogerchengn...@gmail.com" wrote:
> > > > On Nov 6, 12:09 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
> > > > wrote:
> > > > > "Is there any macro...?" There is now!
>
> > > > > The macro below will do what you want. You could even expand it later to
> > > > > permit more answer options - it's set for 4 options now in array
> > > > > possibleAnswers().
>
> > > > > Press [Alt]+[F11] to open the VB Editor, choose Insert | Module and copy and
> > > > > paste the code into the module presented. Choose the sheet with the student
> > > > > answer entries in it, and use Tools | Macro | Macros to run the macro. It
> > > > > presumes that NO percentages have been calculated for any row when you run it.
> > > > > Also presumes that QID is in column A and all that follow it on a row are
> > > > > answers entered by students when it begins.
>
> > > > > Sub CalcResults()
> > > > > 'must start with QID and answer inputs ONLY
> > > > > 'you'll need to clear any previous entries
> > > > > 'on ALL rows before using this
> > > > > '
> > > > > 'you must have the data sheet selected
> > > > > 'before running this Macro
> > > > > '
> > > > > Const firstAnswerRow = 2 ' first row # with question data
> > > > > Dim possibleAnswers(1 To 4) As String
> > > > > Dim resultsChosenCounts() As Long
> > > > > Dim lastRow As Long
> > > > > Dim lastCol As Long
> > > > > Dim maxColumns As Long
> > > > > Dim baseCell As Range
> > > > > Dim rOffset As Long
> > > > > Dim cOffset As Long
> > > > > Dim numEntries As Long
> > > > > Dim selectionCount As Long
> > > > > Dim ALC As Integer ' array loop counter
>
> > > > > 'initialize possibleAnswers() array
> > > > > possibleAnswers(1) = "a" ' case is not important
> > > > > possibleAnswers(2) = "b"
> > > > > possibleAnswers(3) = "c"
> > > > > possibleAnswers(4) = "d"
> > > > > ReDim resultsChosenCounts(LBound(possibleAnswers) To _
> > > > > UBound(possibleAnswers)) ' dimensions must match
> > > > > If Val(Left(Application.Version, 2)) < 12 Then
> > > > > 'in Excel 2003 or earlier
> > > > > lastRow = Range("A" & Rows.Count).End(xlUp).Row
> > > > > maxColumns = Columns.Count
> > > > > Else
> > > > > 'in Excel 2007 (or later)
> > > > > lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
> > > > > maxColumns = Columns.Count
> > > > > End If
> > > > > If lastRow < firstAnswerRow Then
> > > > > Exit Sub ' no question data entered
> > > > > End If
> > > > > Set baseCell = ActiveSheet.Range("A" & firstAnswerRow)
> > > > > 'start looping through used rows
> > > > > Do Until rOffset + baseCell.Row > lastRow
> > > > > lastCol = baseCell.Offset(rOffset, 0).End(xlToRight).Column
> > > > > numEntries = lastCol - 1 ' assumes all are question results
> > > > > If lastCol > (maxColumns - UBound(resultsChosenCounts)) Then
> > > > > MsgBox "Not Enough Columns to Present all Results.", _
> > > > > vbOKOnly, "Aborting"
> > > > > Set baseCell = Nothing
> > > > > Exit Sub
> > > > > End If
> > > > > 'reset/initialize
> > > > > selectionCount = 0
> > > > > cOffset = 1 ' start looking in Col B
> > > > > For ALC = LBound(resultsChosenCounts) To _
> > > > > UBound(resultsChosenCounts)
> > > > > resultsChosenCounts(ALC) = 0 ' reset
> > > > > Next
> > > > > For ALC = LBound(possibleAnswers) To UBound(possibleAnswers)
> > > > > For cOffset = 1 To lastCol - 1
> > > > > If UCase(Trim(baseCell.Offset(rOffset, cOffset))) = _
> > > > > UCase(Trim(possibleAnswers(ALC))) Then
> > > > > resultsChosenCounts(ALC) = resultsChosenCounts(ALC) + 1
> > > > > End If
> > > > > Next
> > > > > Next ' end ALC loop
> > > > > For ALC = LBound(resultsChosenCounts) To _
> > > > > UBound(resultsChosenCounts)
> > > > > baseCell.Offset(rOffset, (lastCol - 1) + ALC) = _
> > > > > resultsChosenCounts(ALC) / numEntries
> > > > > baseCell.Offset(rOffset, (lastCol - 1) + ALC).Style = _
> > > > > "Percent"
> > > > > Next ' end ALC output loop
> > > > > rOffset = rOffset + 1 ' move to next row
> > > > > Loop ' row loop
> > > > > End Sub
>
> > > > > "tomaski" wrote:
> > > > > > Hi,
>
> > > > > > I have a spreadsheet looks like this:
>
> > > > > > QID C1 C2 C3 C4 %a %b %c %d
> > > > > > 13123 b b b b 0 100% 0% 0%
> > > > > > 13124 d d d d 0% 0% 0% 100%
> > > > > > 13125 d d d d 0% 0% 0% 100%
>
> > > > > > QID is the question ID and C1 to C4 are the answers by students. Column "%a"
> > > > > > is the percentage of "a" answered by students. I use countif function to
> > > > > > calculate that.
>
> > > > > > Everytime I copy and paste a group of answers the number of questions (
> > > > > > number of rows) and number of answers (number of columns) will be different.
> > > > > > Is there any macro that will calculate (%a, %b, %c and %d) and insert the
> > > > > > result in the first empty column?
>
> > > > > > Hope this is clear enough. Any answer will be appreciated!!
>
> > > > Thanks so much for your reply!!!! That is really a lifesaver!!!!
>
> > > > The code will calculate only if answers are filled. Is there anyway to
> > > > perform more accurate calculation if some answers are left blank?
>
> > > > Once again, thanks for your prompt reply!!!!!
>
> > Yes. That's exactly what I meant.
> > Thanks for your neat code!!!

Thanks A LOT!!!!

On Nov 7, 9:12 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
wrote:
> In that case, these modifications in the way we find the last used column
> (looking from right edge of sheet back to the left) and the way we count
> entries found will do the calculations the way you want:
>
> Sub CalcResults()
> 'must start with QID and answer inputs ONLY
> 'you'll need to clear any previous entries
> 'on ALL rows before using this
> '
> 'you must have the data sheet selected
> 'before running this Macro
> '
> Const firstAnswerRow = 2 ' first row # with question data
> Dim possibleAnswers(1 To 4) As String
> Dim resultsChosenCounts() As Long
> Dim lastRow As Long
> Dim lastCol As Long
> Dim maxColumns As Long
> Dim baseCell As Range
> Dim rOffset As Long
> Dim cOffset As Long
> Dim numEntries As Long
> Dim selectionCount As Long
> Dim ALC As Integer ' array loop counter
>
> 'initialize possibleAnswers() array
> possibleAnswers(1) = "a" ' case is not important
> possibleAnswers(2) = "b"
> possibleAnswers(3) = "c"
> possibleAnswers(4) = "d"
> ReDim resultsChosenCounts(LBound(possibleAnswers) To _
> UBound(possibleAnswers)) ' dimensions must match
> If Val(Left(Application.Version, 2)) < 12 Then
> 'in Excel 2003 or earlier
> lastRow = Range("A" & Rows.Count).End(xlUp).Row
> maxColumns = Columns.Count
> Else
> 'in Excel 2007 (or later)
> lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
> maxColumns = Columns.Count
> End If
> If lastRow < firstAnswerRow Then
> Exit Sub ' no question data entered
> End If
> Set baseCell = ActiveSheet.Range("A" & firstAnswerRow)
> 'start looping through used rows
> Do Until rOffset + baseCell.Row > lastRow
> numEntries = 0 ' initialize/reset
> lastCol = baseCell.Offset(rOffset, Columns.Count -
> baseCell.Column).End(xlToLeft).Column
> If lastCol > (maxColumns - UBound(resultsChosenCounts)) Then
> MsgBox "Not Enough Columns to Present all Results.", _
> vbOKOnly, "Aborting"
> Set baseCell = Nothing
> Exit Sub
> End If
> 'reset/initialize
> selectionCount = 0
> cOffset = 1 ' start looking in Col B
> For ALC = LBound(resultsChosenCounts) To _
> UBound(resultsChosenCounts)
> resultsChosenCounts(ALC) = 0 ' reset
> Next
> For ALC = LBound(possibleAnswers) To UBound(possibleAnswers)
> For cOffset = 1 To lastCol - 1
> If UCase(Trim(baseCell.Offset(rOffset, cOffset))) = _
> UCase(Trim(possibleAnswers(ALC))) Then
> resultsChosenCounts(ALC) = resultsChosenCounts(ALC) + 1
> numEntries = numEntries + 1
> End If
> Next
> Next ' end ALC loop
> For ALC = LBound(resultsChosenCounts) To _
> UBound(resultsChosenCounts)
> baseCell.Offset(rOffset, (lastCol - 1) + ALC) = _
> resultsChosenCounts(ALC) / numEntries
> baseCell.Offset(rOffset, (lastCol - 1) + ALC).Style = _
> "Percent"
> Next ' end ALC output loop
> rOffset = rOffset + 1 ' move to next row
> Loop ' row loop
> End Sub
>
> "rogerchengn...@gmail.com" wrote:
> > On Nov 7, 5:18 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
> > wrote:
> > > Should not be too difficult to change the code to do that - I presume that
> > > you mean a situation like this (for first row of 'b's) that if it were b b
> > > b then total answers would be 3 vs 4? To expand further, then if inputs were
> > > a b c the results would be:
> > > %a = 33.33% %b = 33.33% %c = 33.33% %d = 0%
>
> > > "rogerchengn...@gmail.com" wrote:
> > > > On Nov 6, 12:09 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
> > > > wrote:
> > > > > "Is there any macro...?" There is now!
>
> > > > > The macro below will do what you want. You could even expand it later to
> > > > > permit more answer options - it's set for 4 options now in array
> > > > > possibleAnswers().
>
> > > > > Press [Alt]+[F11] to open the VB Editor, choose Insert | Module and copy and
> > > > > paste the code into the module presented. Choose the sheet with the student
> > > > > answer entries in it, and use Tools | Macro | Macros to run the macro. It
> > > > > presumes that NO percentages have been calculated for any row when you run it.
> > > > > Also presumes that QID is in column A and all that follow it on a row are
> > > > > answers entered by students when it begins.
>
> > > > > Sub CalcResults()
> > > > > 'must start with QID and answer inputs ONLY
> > > > > 'you'll need to clear any previous entries
> > > > > 'on ALL rows before using this
> > > > > '
> > > > > 'you must have the data sheet selected
> > > > > 'before running this Macro
> > > > > '
> > > > > Const firstAnswerRow = 2 ' first row # with question data
> > > > > Dim possibleAnswers(1 To 4) As String
> > > > > Dim resultsChosenCounts() As Long
> > > > > Dim lastRow As Long
> > > > > Dim lastCol As Long
> > > > > Dim maxColumns As Long
> > > > > Dim baseCell As Range
> > > > > Dim rOffset As Long
> > > > > Dim cOffset As Long
> > > > > Dim numEntries As Long
> > > > > Dim selectionCount As Long
> > > > > Dim ALC As Integer ' array loop counter
>
> > > > > 'initialize possibleAnswers() array
> > > > > possibleAnswers(1) = "a" ' case is not important
> > > > > possibleAnswers(2) = "b"
> > > > > possibleAnswers(3) = "c"
> > > > > possibleAnswers(4) = "d"
> > > > > ReDim resultsChosenCounts(LBound(possibleAnswers) To _
> > > > > UBound(possibleAnswers)) ' dimensions must match
> > > > > If Val(Left(Application.Version, 2)) < 12 Then
> > > > > 'in Excel 2003 or earlier
> > > > > lastRow = Range("A" & Rows.Count).End(xlUp).Row
> > > > > maxColumns = Columns.Count
> > > > > Else
> > > > > 'in Excel 2007 (or later)
> > > > > lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
> > > > > maxColumns = Columns.Count
> > > > > End If
> > > > > If lastRow < firstAnswerRow Then
> > > > > Exit Sub ' no question data entered
> > > > > End If
> > > > > Set baseCell = ActiveSheet.Range("A" & firstAnswerRow)
> > > > > 'start looping through used rows
> > > > > Do Until rOffset + baseCell.Row > lastRow
> > > > > lastCol = baseCell.Offset(rOffset, 0).End(xlToRight).Column
> > > > > numEntries = lastCol - 1 ' assumes all are question results
> > > > > If lastCol > (maxColumns - UBound(resultsChosenCounts)) Then
> > > > > MsgBox "Not Enough Columns to Present all Results.", _
> > > > > vbOKOnly, "Aborting"
> > > > > Set baseCell = Nothing
> > > > > Exit Sub
> > > > > End If
> > > > > 'reset/initialize
> > > > > selectionCount = 0
> > > > > cOffset = 1 ' start looking in Col B
> > > > > For ALC = LBound(resultsChosenCounts) To _
> > > > > UBound(resultsChosenCounts)
> > > > > resultsChosenCounts(ALC) = 0 ' reset
> > > > > Next
> > > > > For ALC = LBound(possibleAnswers) To UBound(possibleAnswers)
> > > > > For cOffset = 1 To lastCol - 1
> > > > > If UCase(Trim(baseCell.Offset(rOffset, cOffset))) = _
> > > > > UCase(Trim(possibleAnswers(ALC))) Then
> > > > > resultsChosenCounts(ALC) = resultsChosenCounts(ALC) + 1
> > > > > End If
> > > > > Next
> > > > > Next ' end ALC loop
> > > > > For ALC = LBound(resultsChosenCounts) To _
> > > > > UBound(resultsChosenCounts)
> > > > > baseCell.Offset(rOffset, (lastCol - 1) + ALC) = _
> > > > > resultsChosenCounts(ALC) / numEntries
> > > > > baseCell.Offset(rOffset, (lastCol - 1) + ALC).Style = _
> > > > > "Percent"
> > > > > Next ' end ALC output loop
> > > > > rOffset = rOffset + 1 ' move to next row
> > > > > Loop ' row loop
> > > > > End Sub
>
> > > > > "tomaski" wrote:
> > > > > > Hi,
>
> > > > > > I have a spreadsheet looks like this:
>
> > > > > > QID C1 C2 C3 C4 %a %b %c %d
> > > > > > 13123 b b b b 0 100% 0% 0%
> > > > > > 13124 d d d d 0% 0% 0% 100%
> > > > > > 13125 d d d d 0% 0% 0% 100%
>
> > > > > > QID is the question ID and C1 to C4 are the answers by students. Column "%a"
> > > > > > is the percentage of "a" answered by students. I use countif function to
> > > > > > calculate that.
>
> > > > > > Everytime I copy and paste a group of answers the number of questions (
> > > > > > number of rows) and number of answers (number of columns) will be different.
> > > > > > Is there any macro that will calculate (%a, %b, %c and %d) and insert the
> > > > > > result in the first empty column?
>
> > > > > > Hope this is clear enough. Any answer will be appreciated!!
>
> > > > Thanks so much for your reply!!!! That is really a lifesaver!!!!
>
> > > > The code will calculate only if answers are filled. Is there anyway to
> > > > perform more accurate calculation if some answers are left blank?
>
> > > > Once again, thanks for your prompt reply!!!!!
>
> > Yes. That's exactly what I meant.
> > Thanks for your neat code!!!

How did you learn the language? You are so good!! Thanks!!!

Self taught BASIC on a TRS-80 Model I about 1979-80, been programming in some
dialect of it ever since. The real trick to programming is learning to
define the problem - that was taught to me through formal training, initially
using FORTRAN and then Honeywell 6000 Assembly Language. I just kept at it
in various languages for many years. And here I am. There are many others
hanging about in here that are easily as skilled as I, and just as many more
that I keep learning from in these and other places around the web.

Glad I was able to help. Enjoy.

"(E-Mail Removed)" wrote:

> On Nov 7, 9:12 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
> wrote:
> > In that case, these modifications in the way we find the last used column
> > (looking from right edge of sheet back to the left) and the way we count
> > entries found will do the calculations the way you want:
> >
> > Sub CalcResults()
> > 'must start with QID and answer inputs ONLY
> > 'you'll need to clear any previous entries
> > 'on ALL rows before using this
> > '
> > 'you must have the data sheet selected
> > 'before running this Macro
> > '
> > Const firstAnswerRow = 2 ' first row # with question data
> > Dim possibleAnswers(1 To 4) As String
> > Dim resultsChosenCounts() As Long
> > Dim lastRow As Long
> > Dim lastCol As Long
> > Dim maxColumns As Long
> > Dim baseCell As Range
> > Dim rOffset As Long
> > Dim cOffset As Long
> > Dim numEntries As Long
> > Dim selectionCount As Long
> > Dim ALC As Integer ' array loop counter
> >
> > 'initialize possibleAnswers() array
> > possibleAnswers(1) = "a" ' case is not important
> > possibleAnswers(2) = "b"
> > possibleAnswers(3) = "c"
> > possibleAnswers(4) = "d"
> > ReDim resultsChosenCounts(LBound(possibleAnswers) To _
> > UBound(possibleAnswers)) ' dimensions must match
> > If Val(Left(Application.Version, 2)) < 12 Then
> > 'in Excel 2003 or earlier
> > lastRow = Range("A" & Rows.Count).End(xlUp).Row
> > maxColumns = Columns.Count
> > Else
> > 'in Excel 2007 (or later)
> > lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
> > maxColumns = Columns.Count
> > End If
> > If lastRow < firstAnswerRow Then
> > Exit Sub ' no question data entered
> > End If
> > Set baseCell = ActiveSheet.Range("A" & firstAnswerRow)
> > 'start looping through used rows
> > Do Until rOffset + baseCell.Row > lastRow
> > numEntries = 0 ' initialize/reset
> > lastCol = baseCell.Offset(rOffset, Columns.Count -
> > baseCell.Column).End(xlToLeft).Column
> > If lastCol > (maxColumns - UBound(resultsChosenCounts)) Then
> > MsgBox "Not Enough Columns to Present all Results.", _
> > vbOKOnly, "Aborting"
> > Set baseCell = Nothing
> > Exit Sub
> > End If
> > 'reset/initialize
> > selectionCount = 0
> > cOffset = 1 ' start looking in Col B
> > For ALC = LBound(resultsChosenCounts) To _
> > UBound(resultsChosenCounts)
> > resultsChosenCounts(ALC) = 0 ' reset
> > Next
> > For ALC = LBound(possibleAnswers) To UBound(possibleAnswers)
> > For cOffset = 1 To lastCol - 1
> > If UCase(Trim(baseCell.Offset(rOffset, cOffset))) = _
> > UCase(Trim(possibleAnswers(ALC))) Then
> > resultsChosenCounts(ALC) = resultsChosenCounts(ALC) + 1
> > numEntries = numEntries + 1
> > End If
> > Next
> > Next ' end ALC loop
> > For ALC = LBound(resultsChosenCounts) To _
> > UBound(resultsChosenCounts)
> > baseCell.Offset(rOffset, (lastCol - 1) + ALC) = _
> > resultsChosenCounts(ALC) / numEntries
> > baseCell.Offset(rOffset, (lastCol - 1) + ALC).Style = _
> > "Percent"
> > Next ' end ALC output loop
> > rOffset = rOffset + 1 ' move to next row
> > Loop ' row loop
> > End Sub
> >
> > "rogerchengn...@gmail.com" wrote:
> > > On Nov 7, 5:18 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
> > > wrote:
> > > > Should not be too difficult to change the code to do that - I presume that
> > > > you mean a situation like this (for first row of 'b's) that if it were b b
> > > > b then total answers would be 3 vs 4? To expand further, then if inputs were
> > > > a b c the results would be:
> > > > %a = 33.33% %b = 33.33% %c = 33.33% %d = 0%
> >
> > > > "rogerchengn...@gmail.com" wrote:
> > > > > On Nov 6, 12:09 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)>
> > > > > wrote:
> > > > > > "Is there any macro...?" There is now!
> >
> > > > > > The macro below will do what you want. You could even expand it later to
> > > > > > permit more answer options - it's set for 4 options now in array
> > > > > > possibleAnswers().
> >
> > > > > > Press [Alt]+[F11] to open the VB Editor, choose Insert | Module and copy and
> > > > > > paste the code into the module presented. Choose the sheet with the student
> > > > > > answer entries in it, and use Tools | Macro | Macros to run the macro. It
> > > > > > presumes that NO percentages have been calculated for any row when you run it.
> > > > > > Also presumes that QID is in column A and all that follow it on a row are
> > > > > > answers entered by students when it begins.
> >
> > > > > > Sub CalcResults()
> > > > > > 'must start with QID and answer inputs ONLY
> > > > > > 'you'll need to clear any previous entries
> > > > > > 'on ALL rows before using this
> > > > > > '
> > > > > > 'you must have the data sheet selected
> > > > > > 'before running this Macro
> > > > > > '
> > > > > > Const firstAnswerRow = 2 ' first row # with question data
> > > > > > Dim possibleAnswers(1 To 4) As String
> > > > > > Dim resultsChosenCounts() As Long
> > > > > > Dim lastRow As Long
> > > > > > Dim lastCol As Long
> > > > > > Dim maxColumns As Long
> > > > > > Dim baseCell As Range
> > > > > > Dim rOffset As Long
> > > > > > Dim cOffset As Long
> > > > > > Dim numEntries As Long
> > > > > > Dim selectionCount As Long
> > > > > > Dim ALC As Integer ' array loop counter
> >
> > > > > > 'initialize possibleAnswers() array
> > > > > > possibleAnswers(1) = "a" ' case is not important
> > > > > > possibleAnswers(2) = "b"
> > > > > > possibleAnswers(3) = "c"
> > > > > > possibleAnswers(4) = "d"
> > > > > > ReDim resultsChosenCounts(LBound(possibleAnswers) To _
> > > > > > UBound(possibleAnswers)) ' dimensions must match
> > > > > > If Val(Left(Application.Version, 2)) < 12 Then
> > > > > > 'in Excel 2003 or earlier
> > > > > > lastRow = Range("A" & Rows.Count).End(xlUp).Row
> > > > > > maxColumns = Columns.Count
> > > > > > Else
> > > > > > 'in Excel 2007 (or later)
> > > > > > lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
> > > > > > maxColumns = Columns.Count
> > > > > > End If
> > > > > > If lastRow < firstAnswerRow Then
> > > > > > Exit Sub ' no question data entered
> > > > > > End If
> > > > > > Set baseCell = ActiveSheet.Range("A" & firstAnswerRow)
> > > > > > 'start looping through used rows
> > > > > > Do Until rOffset + baseCell.Row > lastRow
> > > > > > lastCol = baseCell.Offset(rOffset, 0).End(xlToRight).Column
> > > > > > numEntries = lastCol - 1 ' assumes all are question results
> > > > > > If lastCol > (maxColumns - UBound(resultsChosenCounts)) Then
> > > > > > MsgBox "Not Enough Columns to Present all Results.", _
> > > > > > vbOKOnly, "Aborting"
> > > > > > Set baseCell = Nothing
> > > > > > Exit Sub
> > > > > > End If
> > > > > > 'reset/initialize
> > > > > > selectionCount = 0
> > > > > > cOffset = 1 ' start looking in Col B
> > > > > > For ALC = LBound(resultsChosenCounts) To _
> > > > > > UBound(resultsChosenCounts)
> > > > > > resultsChosenCounts(ALC) = 0 ' reset
> > > > > > Next
> > > > > > For ALC = LBound(possibleAnswers) To UBound(possibleAnswers)
> > > > > > For cOffset = 1 To lastCol - 1
> > > > > > If UCase(Trim(baseCell.Offset(rOffset, cOffset))) = _
> > > > > > UCase(Trim(possibleAnswers(ALC))) Then
> > > > > > resultsChosenCounts(ALC) = resultsChosenCounts(ALC) + 1
> > > > > > End If
> > > > > > Next
> > > > > > Next ' end ALC loop
> > > > > > For ALC = LBound(resultsChosenCounts) To _
> > > > > > UBound(resultsChosenCounts)
> > > > > > baseCell.Offset(rOffset, (lastCol - 1) + ALC) = _
> > > > > > resultsChosenCounts(ALC) / numEntries
> > > > > > baseCell.Offset(rOffset, (lastCol - 1) + ALC).Style = _
> > > > > > "Percent"
> > > > > > Next ' end ALC output loop
> > > > > > rOffset = rOffset + 1 ' move to next row
> > > > > > Loop ' row loop
> > > > > > End Sub
> >
> > > > > > "tomaski" wrote:
> > > > > > > Hi,
> >
> > > > > > > I have a spreadsheet looks like this:
> >
> > > > > > > QID C1 C2 C3 C4 %a %b %c %d
> > > > > > > 13123 b b b b 0 100% 0% 0%
> > > > > > > 13124 d d d d 0% 0% 0% 100%
> > > > > > > 13125 d d d d 0% 0% 0% 100%
> >
> > > > > > > QID is the question ID and C1 to C4 are the answers by students. Column "%a"
> > > > > > > is the percentage of "a" answered by students. I use countif function to
> > > > > > > calculate that.
> >
> > > > > > > Everytime I copy and paste a group of answers the number of questions (
> > > > > > > number of rows) and number of answers (number of columns) will be different.
> > > > > > > Is there any macro that will calculate (%a, %b, %c and %d) and insert the
> > > > > > > result in the first empty column?
> >
> > > > > > > Hope this is clear enough. Any answer will be appreciated!!
> >
> > > > > Thanks so much for your reply!!!! That is really a lifesaver!!!!
> >
> > > > > The code will calculate only if answers are filled. Is there anyway to
> > > > > perform more accurate calculation if some answers are left blank?
> >
> > > > > Once again, thanks for your prompt reply!!!!!
> >
> > > Yes. That's exactly what I meant.
> > > Thanks for your neat code!!!
>
> How did you learn the language? You are so good!! Thanks!!!
>
>