Excel Formula or VBA if necessary

[Claret]

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

Qu1

Qu2

Qu3

Qu4

Qu5

Qu6

Qu7

Qu8

Qu9

Qu10

Person 1

1

2

1

1

Qu1 (1)

Qu3 (2)

Qu5 (1)

Qu7 (1)

Person 2

1

2

1

1

Qu2 (1)

Qu6 (2)

Qu9 (1)

Qu10 (1)

Person 3

Person 4

1

Qu4 (1)

Person 5

1

3

1

Qu3 (1)

Qu5 (3)

Qu8 (1)

<tbody>
</tbody>

 

[Claret]

I've amended the code as stated but this sees the column headers for any questions that are incorrect added followed by a line of white space and then the count of instances for the header (this is instead of the question number and number of instances as was showing previously).

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(2, myCol)) & Chr(10) & Cells(myRow, myCol)

' Increment popCol
popCol = popCol + 1
End If
Next myCol
Next myRow

Application.ScreenUpdating = True

End Sub

 

[Joe4]

I am not sure I understand what you are telling me.
Could you show me some picture examples like you did in your first post?

 

[stunnrock]

If you'd like to try it with a formula, put this in BJ2, then copy it along and down as far as required:

=IF(COUNT($B2:$BI2)>COLUMN()-COLUMN($BJ:$BJ),INDEX(OFFSET($B$1:$BI$1,,IF(COLUMN()=COLUMN($BJ:$BJ),0,MATCH(TRIM(LEFT(BI2,4)),$B$1:$BI$1,0))),MATCH(TRUE,INDEX(ISNUMBER(OFFSET($B2:$BI2,,IF(COLUMN()=COLUMN($BJ:$BJ),0,MATCH(TRIM(LEFT(BI2,4)),$B$1:$BI$1,0)))),),0))&" ("&INDEX(OFFSET($B2:$BI2,,IF(COLUMN()=COLUMN($BJ:$BJ),0,MATCH(TRIM(LEFT(BI2,4)),$B$1:$BI$1,0))),MATCH(TRUE,INDEX(ISNUMBER(OFFSET($B2:$BI2,,IF(COLUMN()=COLUMN($BJ:$BJ),0,MATCH(TRIM(LEFT(BI2,4)),$B$1:$BI$1,0)))),),0))&")","")

This will need some adjustment if you end up with more than 99 questions, otherwise it should be fine. However, VBA will probably perform much faster.

 

[Claret]

Just for information - row 1 is completely blank and all data starts in row two:

This is with the revised trim code:

Advisor Name	Error 1	Error 2	Error 3	Error 4	Error 5	Error 6	Error 7	Error 8	Error 9
Aitoro, Richard	REG: When registering a client, capture if they are on an active debt solution or if they've tried other debt solutions in the past. If relevant, note why these didn't succeed 1	Capture the referral source accurately 1	REG: Discuss and agree priority arrears arrangements if applicable 1	REG: Advise the client on the detailed facts in the Gateway for the solution they have chosen. Cover bank account advice 1	REG: Give the client appropriate collections advice 1	Address any client concerns and provide details of any key next steps if appropriate 1	Accurately result every call taken 1	Accurately reflect important information and key discussion points in the notes 1	Add correct and meaningful additional comments into the PAP 1
	Open the call appropriately Q1 1	Capture all relevant information relating to the Household screen accurately Q11 1	Create a budget that is collaborative, realistic and clear Q19 1
	Create a budget that is collaborative, realistic and clear 1
	Capture all relevant information relating to the Debts screen accurately, including guarantor and guaranteed debts, disputed debts and statute barred debts 1	Inform the client that costs listed as priority payments are essential and should be maintained before other payments 1	REG: Give the client appropriate collections advice 1	Address any client concerns and provide details of any key next steps if appropriate 1	Accurately reflect important information and key discussion points in the notes 1	Add correct and meaningful additional comments into the PAP 1
	Capture all relevant information relating to the Priority Expenditure screen accurately 1	REG: Give the client appropriate collections advice 1	Accurately reflect important information and key discussion points in the notes 1	REG: Provide the appropriate and correct advice and/or information to the client, making sure the client understands this 1
	Inform the client that costs listed as priority payments are essential and should be maintained before other payments 1
	Inform the client that costs listed as priority payments are essential and should be maintained before other payments 1

<colgroup><col width="159" style="width: 119pt; mso-width-source: userset; mso-width-alt: 5814;"> <col width="75" style="width: 56pt; mso-width-source: userset; mso-width-alt: 2742;"> <col width="64" style="width: 48pt;" span="2"> <col width="73" style="width: 55pt; mso-width-source: userset; mso-width-alt: 2669;"> <col width="64" style="width: 48pt;" span="5"> <tbody> </tbody>

This is with the original code - which is working as I wanted with the exception of there being a line of white space ahead of the data in each cell.

Advisor Name	Error 1	Error 2	Error 3	Error 4	Error 5	Error 6	Error 7	Error 8	Error 9
Aitoro, Richard	1	1	1	1	1	1	1	1	1
	Q1 1	Q11 1	Q19 1
	1
	1	1	1	1	1	1
	1	1	1	1

<colgroup><col width="159" style="width: 119pt; mso-width-source: userset; mso-width-alt: 5814;"> <col width="75" style="width: 56pt; mso-width-source: userset; mso-width-alt: 2742;"> <col width="64" style="width: 48pt;" span="2"> <col width="73" style="width: 55pt; mso-width-source: userset; mso-width-alt: 2669;"> <col width="64" style="width: 48pt;" span="5"> <tbody> </tbody>

 

[Joe4]

which is working as I wanted with the exception of there being a line of white space ahead of the data in each cell.

Are you sure that is what is actually going on, and it isn't just a formatting issue?
Note that if a row widths expands to account for carriage returns and data wrapping, the default format option for Vertical Alignment is "Bottom", which means the data is the bottom, so the white space appears at the top and not the bottom of a cell. You can change that to "Top" or "Center", if you don't like the way it looks.

 

[Claret]

Hi Joe

Yes - expanding the column widths, with the text at the top of the cell and ensuring wrapping is removed still sees a full row of white space ahead of the result.

Cheers

David

 

[Claret]

That's some formula stunrock!! Thanks for this - I'll stick with the VBA option due to filesize but will have a look at that formula - thanks again.

David

 

[stunnrock]

Glad to help, but I can't blame you for sticking with the VBA.

 

[Claret]

Hi Joe4

I've amended the code slightly (changing the CHR from 10 to 42) which puts a blank space in, instead of a new row.

The only issue that I have now is that the codes is returning the full question for example; QU18.0 REG: QQQQQQQQ 1

What I need it to return is QU18.0 1 (with the 1 being a changeable number depending on how many times this particular question may have been answered incorrectly... The QU18.0 could of course change depending on which questions were incorrect.

Any further help would be much appreciated.

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 B
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(2, myCol)) & Chr(32) & Cells(myRow, myCol)

' Increment popCol
popCol = popCol + 1
End If
Next myCol
Next myRow

Range("BK3:CD600").Select
Range("CD3").Activate
Dim myRow As Long
Dim myCol As Long
Dim popCol As Long


Application.ScreenUpdating = False

 

[Joe4]

The only issue that I have now is that the codes is returning the full question for example; QU18.0 REG: QQQQQQQQ 1

What I need it to return is QU18.0 1 (with the 1 being a changeable number depending on how many times this particular question may have been answered incorrectly... The QU18.0 could of course change depending on which questions were incorrect.

Not sure I follow, but this really appears to be a new question (though it may be on the same project), so you are probably best off posting it to a new thread.