Moving and manipulating data between sheets

Question

The organisation I work for is using Slido to assess candidate's knowledge, or lack of it. Slido produces an XLS file of what the responses were to a particular question. The XLS produced by Slido has no formatting beyond adding a extra row for each participant. For example, when there are three possible correct answers these are all contained in one cell, with no formatting or wrapping, with just 'correct' or 'incorrect' after the response given. The number of columns correspond to the number of questions, and are headed by what the question was. What I am hoping to do, if possible, is extract the responses individually by name, with the responses to each question in a separate cell (horizontal), and each question on the vertical axis, creating a new sheet for every individual. The participant's name is in column B, column E contains the total number of correct answers, and the questions and responses start at column F and end at column AB. The contents of columns A, C &amp; D are not important and could be discarded. Any help or advice gratefully received...

kidd_ip · Answer

Try this in VBA:
&nbsp;
Sub ExtractResponses()
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
    Dim colStart As Long
    Dim colEnd As Long
    Dim participantName As String
    Dim questionHeaders As Range
    Dim questionResponses As Range
    
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace with your sheet name
    
    ' Identify the range containing the questions
    Set questionHeaders = ws.Range("F1:AB1") ' Adjust if needed
    colStart = questionHeaders.Column
    colEnd = colStart + questionHeaders.Columns.Count - 1
    
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' Loop through each participant
    For i = 2 To lastRow ' Assuming row 1 has headers
        participantName = ws.Cells(i, "B").Value
        Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        newWs.Name = participantName
        
        ' Copy question headers to new sheet
        For j = colStart To colEnd
            newWs.Cells(1, j - colStart + 1).Value = ws.Cells(1, j).Value
        Next j
        
        ' Copy question responses to new sheet
        For j = colStart To colEnd
            newWs.Cells(2, j - colStart + 1).Value = ws.Cells(i, j).Value
        Next j
        
        ' Copy total number of correct answers to new sheet (optional)
        newWs.Cells(3, 1).Value = "Total Correct"
        newWs.Cells(3, 2).Value = ws.Cells(i, "E").Value
        
    Next i
End Sub

&nbsp;

Forum Discussion

Moving and manipulating data between sheets

1 Reply

Resources