Listing multiple values in a single cell if they match

[mwilburn01]

Hello all,

I have a Gradebook where I enter the number of points a student earns per question on a test. The students names are in the first column and then their points follow. I have other columns such as total points, percentage, letter grade that follow but they are not part of my issue. I am simply looking for a way to list which problems they did not earn full credit on. First two Rows (after their name) list the question # and possible points. I have figured something out that kind of works but it is extremely long and I am sure there is a better way to do it.

Name	1	2	3	4	5	6	7	WHAT I AM LOOKING FOR
(Merged with above)	2	2	2	2	3	3	4	WOULD LOOK LIKE THIS
Sue	2	0	2	1	3	2	4	2, 4, 6
Jimmy	2	2	2	2	2	3	4	5
Sally	1	0	0	0	3	0	0	1, 2, 3, 4, 6

<tbody>
</tbody>

Any help is much appreciated.

 

[hiker95]

mwilburn01,

Welcome to the MrExcel forum.

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?


The below macro should work for a varying number of rows, and, columns.


Sample raw data:

Excel 2007
	A	B	C	D	E	F	G	H	I
1	Name	1	2	3	4	5	6	7
2	(Merged with above)	2	2	2	2	3	3	4
3	Sue	2	0	2	1	3	2	4
4	Jimmy	2	2	2	2	2	3	4
5	Sally	1	0	0	0	3	0	0
6
Sheet1

After the macro:

Excel 2007
	A	B	C	D	E	F	G	H	I
1	Name	1	2	3	4	5	6	7
2	(Merged with above)	2	2	2	2	3	3	4
3	Sue	2	0	2	1	3	2	4	2, 4, 6
4	Jimmy	2	2	2	2	2	3	4	5
5	Sally	1	0	0	0	3	0	0	1, 2, 3, 4, 6, 7
6
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub ReportNotFullCredit()
' hiker95, 03/27/2014, ME767407
Dim a As Variant, i As Long, c As Long
Dim lr As Long, lc As Long, s As String
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
a = Range(Cells(1, 1), Cells(lr, lc + 1))
For i = 3 To lr
  s = ""
  For c = 2 To lc
    If a(i, c) <> a(2, c) Then s = s & a(1, c) & ", "
  Next c
  If s <> "" Then
    If Right(s, 2) = ", " Then s = Left(s, Len(s) - 2)
    a(i, lc + 1) = s
  End If
Next i
Range(Cells(1, 1), Cells(lr, lc + 1)) = a
Range(Cells(3, lc + 1), Cells(lr, lc + 1)).HorizontalAlignment = xlLeft
Columns(lc + 1).AutoFit
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReportNotFullCredit macro.