Excel Formula or VBA if necessary

Claret

New Member
Joined
Mar 6, 2017
Messages
14
Hello,

I have a table of data (shortened example below) with 40+ questions and 500 + respondents.

The green section of the table indicates the questions that were answered incorrectly by an individual and the number of times they answered the question incorrectly (these are quality checks so the same questions are checked multiple times)

I'd like to be able to consolidate the data (via either formula or simple code) so that for each person, just the incorrect questions and the number of times incorrect are shown (as per the example in the red section of the table). Effectively ignoring those where there are no errors and returning a horizontal list of errors in separate cells with no blanks.

Any help would be much appreciated.

David



[TABLE="width: 525"]
<tbody>[TR]
[TD="class: xl67, width: 55, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, width: 40, bgcolor: #EBF1DE"]Qu1
[/TD]
[TD="class: xl68, width: 40, bgcolor: #EBF1DE"]Qu2
[/TD]
[TD="class: xl68, width: 40, bgcolor: #EBF1DE"]Qu3
[/TD]
[TD="class: xl68, width: 40, bgcolor: #EBF1DE"]Qu4
[/TD]
[TD="class: xl68, width: 40, bgcolor: #EBF1DE"]Qu5
[/TD]
[TD="class: xl68, width: 40, bgcolor: #EBF1DE"]Qu6
[/TD]
[TD="class: xl68, width: 40, bgcolor: #EBF1DE"]Qu7
[/TD]
[TD="class: xl68, width: 40, bgcolor: #EBF1DE"]Qu8
[/TD]
[TD="class: xl68, width: 40, bgcolor: #EBF1DE"]Qu9
[/TD]
[TD="class: xl68, width: 40, bgcolor: #EBF1DE"]Qu10
[/TD]
[TD="class: xl66, width: 61, bgcolor: transparent"][/TD]
[TD="class: xl66, width: 61, bgcolor: transparent"][/TD]
[TD="class: xl66, width: 61, bgcolor: transparent"][/TD]
[TD="class: xl66, width: 61, bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl67, bgcolor: #EBF1DE"]Person 1
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"]1
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"]2
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"]1
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"]1
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl69, bgcolor: #F2DCDB"]Qu1 (1)
[/TD]
[TD="class: xl69, bgcolor: #F2DCDB"]Qu3 (2)
[/TD]
[TD="class: xl69, bgcolor: #F2DCDB"]Qu5 (1)
[/TD]
[TD="class: xl69, bgcolor: #F2DCDB"]Qu7 (1)
[/TD]
[/TR]
[TR]
[TD="class: xl67, bgcolor: #EBF1DE"]Person 2
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"]1
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"]2
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"]1
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"]1
[/TD]
[TD="class: xl69, bgcolor: #F2DCDB"]Qu2 (1)
[/TD]
[TD="class: xl69, bgcolor: #F2DCDB"]Qu6 (2)
[/TD]
[TD="class: xl69, bgcolor: #F2DCDB"]Qu9 (1)
[/TD]
[TD="class: xl69, bgcolor: #F2DCDB"]Qu10 (1)
[/TD]
[/TR]
[TR]
[TD="class: xl67, bgcolor: #EBF1DE"]Person 3
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl69, bgcolor: #F2DCDB"][/TD]
[TD="class: xl69, bgcolor: #F2DCDB"][/TD]
[TD="class: xl69, bgcolor: #F2DCDB"][/TD]
[TD="class: xl69, bgcolor: #F2DCDB"][/TD]
[/TR]
[TR]
[TD="class: xl67, bgcolor: #EBF1DE"]Person 4
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"]1
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl69, bgcolor: #F2DCDB"]Qu4 (1)
[/TD]
[TD="class: xl69, bgcolor: #F2DCDB"][/TD]
[TD="class: xl69, bgcolor: #F2DCDB"][/TD]
[TD="class: xl69, bgcolor: #F2DCDB"][/TD]
[/TR]
[TR]
[TD="class: xl67, bgcolor: #EBF1DE"]Person 5
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"]1
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"]3
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"]1
[/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl68, bgcolor: #EBF1DE"][/TD]
[TD="class: xl69, bgcolor: #F2DCDB"]Qu3 (1)
[/TD]
[TD="class: xl69, bgcolor: #F2DCDB"]Qu5 (3)
[/TD]
[TD="class: xl69, bgcolor: #F2DCDB"]Qu8 (1)
[/TD]
[TD="class: xl69, bgcolor: #F2DCDB"][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Exactly what rows/columns are your data tables in?
 
Upvote 0
Assuming it starts up in cell A1, so the table goes out to column K, this VBA code will do what you want:
Code:
Sub MyMacro()

    Dim lastRow As Long
    Dim myRow As Long
    Dim myCol As Long
    Dim popCol As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column A
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows
    For myRow = 2 To lastRow
'       Set first column to populate
        popCol = 12
'       Loop through columns B-K
        For myCol = 2 To 11
'           If value is greater than zero, write to end of table
            If Cells(myRow, myCol) > 0 Then
                Cells(myRow, popCol) = Cells(1, myCol) & Chr(10) & "(" & Cells(myRow, myCol) & ")"
'               Increment popCol
                popCol = popCol + 1
            End If
        Next myCol
    Next myRow
    
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
I've amended the code slightly (see below) because the brackets were appearing as (Q1 1) rather than Q1 (1). This is fine, but another minor issue is that the Q1 1 is now appearing in the cells with a line of white space ahead of it - is there a way to adapt the code to prevent this or alternatively can some trim code be added?

Thanks very much for your help with this - it's much appreciated.

David
 
Upvote 0
Helps if I do add the code of course :-)

Dim lastRow As Long
Dim myRow As Long
Dim myCol As Long
Dim popCol As Long


Application.ScreenUpdating = False

' Find last row with data in column A
lastRow = Cells(Rows.Count, "B").End(xlUp).Row

' Loop through all rows
For myRow = 3 To lastRow
' Set first column to populate
popCol = 63
' Loop through columns B-K
For myCol = 4 To 60
' If value is greater than zero, write to end of table
If Cells(myRow, myCol) > 0 Then
Cells(myRow, popCol) = Cells(1, myCol) & Chr(10) & Cells(myRow, myCol)
' Increment popCol
popCol = popCol + 1
End If
Next myCol
Next myRow

Application.ScreenUpdating = True

End Sub
 
Upvote 0
but another minor issue is that the Q1 1 is now appearing in the cells with a line of white space ahead of it
I am guessing that is because your headers in row 1 may have space before them.
If that is the case, add the TRIM function, i.e.
Code:
[COLOR=#333333]Cells(myRow, popCol) = Trim(Cells(1, myCol)) & Chr(10) & Cells(myRow, myCol)[/COLOR]
 
Upvote 0
Thanks Joe4

I've amended the code but still have the same issue - the headers are actually in row 2 in row and not row 1. Is this something I've neglected to amend in the code? Sorry - not particularly VBA literate as you'll no doubt have gathered.

David

Dim lastRow As Long
Dim myRow As Long
Dim myCol As Long
Dim popCol As Long


Application.ScreenUpdating = False

' Find last row with data in column A
lastRow = Cells(Rows.Count, "B").End(xlUp).Row

' Loop through all rows
For myRow = 3 To lastRow
' Set first column to populate
popCol = 63
' Loop through columns B-K
For myCol = 4 To 60
' If value is greater than zero, write to end of table
If Cells(myRow, myCol) > 0 Then
Cells(myRow, popCol) = Trim(Cells(1, myCol)) & Chr(10) & Cells(myRow, myCol)
' Increment popCol
popCol = popCol + 1
End If
Next myCol
Next myRow

Application.ScreenUpdating = True

End Sub
 
Upvote 0
Yes, if the headers are in row 2, you need to amend this line:
Code:
[COLOR=#333333]Cells(myRow, popCol) = Trim(Cells([/COLOR][COLOR=#ff0000][B]2[/B][/COLOR][COLOR=#333333], myCol)) & Chr(10) & Cells(myRow, myCol)[/COLOR]
 
Upvote 0

Forum statistics

Threads
1,223,904
Messages
6,175,295
Members
452,631
Latest member
a_potato

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top