Copy Paste User Selection from Form to Excel.

[Aswinraj]

Hello guys,

I have a form where it will display the random questions from "Questions" Sheet to the User.
User will Select the Answer in the Form.

I Need to Save all those Random Questions (as of now its 10) and Answer which User attend, Save it in "Answer" Sheet. Can you please Help on this. Only this part is pending to complete my work.


Attached the Macro here: Untitled folder - Google Drive

 

[dmt32]

Hi,

Not had long but I have made an attempt to update your project in hope that it will do what you want

1 - Make a BACKUP of your workbook & then DELETE ALL the code in your userform

2 – add an additional commandButton to your UserForm and name it BACKBUTTON

3 – Place ALL following code as shown in your UserForms code page (do not make any changes)

Dim counter As Integer
Dim TotalQ As Integer, ans As Integer
Dim QuestionRow() As Long
Dim wsQuestions As Worksheet
Dim UserAnswers() As Variant

Private Sub Answer1_Click()
    Button.Enabled = True
End Sub
Private Sub Answer2_Click()
    Button.Enabled = True
End Sub
Private Sub Answer3_Click()
    Button.Enabled = True
End Sub
Private Sub Answer4_Click()
    Button.Enabled = True
End Sub

Private Sub Button_Click()
Dim NextRow As Long
   
'get answer & clear control for next question
    For ans = 1 To 4
        With Me.Controls("Answer" & ans)
            If .Value Then .Value = False: Exit For
        End With
    Next

'*****************************************************************************************
'********************************store responses to array*********************************

'username
        UserAnswers(counter, 1) = Environ("USERNAME")
'questions
        UserAnswers(counter, 2) = wsQuestions.Cells(QuestionRow(counter), 1).Text
'selected answers
        UserAnswers(counter, 3) = wsQuestions.Cells(QuestionRow(counter), ans + 1).Text
       
'*****************************************************************************************
       
   
    ansacc = CInt(Range("Questions!F" & QuestionRow(counter)).Text)
    If (ansacc = ans) Then
        status.Width = status.Width + 30
    End If
   
'get next question
    GetQuestion xlNext
   
    If counter > TotalQ Then
        Me.Hide
        MsgBox ("Your score is " & TotalQ * status.Width / 30 & "%")
'answers to worksheet
        With ThisWorkbook.Worksheets("Answers")
'get next row
            NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
'post array to range
            .Cells(NextRow, 1).Resize(UBound(UserAnswers, 1), 3).Value = UserAnswers()
        End With
        Unload Me
    End If
End Sub

Private Sub BackButton_Click()
    GetQuestion xlPrevious
End Sub

Sub GetQuestion(ByVal Direction As XlSearchDirection)
    Dim i As Integer
    Dim EnableButton As Boolean
   
'counter value
    counter = IIf(Direction = xlNext, counter + 1, counter - 1)
   
    If counter <= TotalQ Then
        Question.Caption = wsQuestions.Cells(QuestionRow(counter), 1).Text
        For i = 1 To 4
            With Me.Controls("Answer" & i)
'get question
                .Caption = wsQuestions.Cells(QuestionRow(counter), i + 1).Text
'show previous value
                .Value = CBool(.Caption = UserAnswers(counter, 3))
                If .Value Then EnableButton = True
            End With
        Next i
'show progress count
        Me.Caption = "Question " & counter & " of " & TotalQ
    End If

    With Me.Button
        .Enabled = EnableButton
        .Caption = IIf(counter = TotalQ, "Finish", "Next >")
    End With
    With Me.BackButton
        .Enabled = CBool(counter > 1)
        .Caption = "< Back"
    End With
End Sub

   
Private Sub UserForm_Initialize()
'******************************************************************************************
'******************DO NOT RENAME THIS EVENT TO MATCH YOUR USERFORM NAME********************
'******************************************************************************************
    Dim i As Integer
    Dim cell As Range
    Set wsQuestions = ThisWorkbook.Worksheets("Questions")
   
'get total questions asked
    TotalQ = wsQuestions.Range("I2").Value
'size arrays
    ReDim UserAnswers(1 To TotalQ, 1 To 3)
    ReDim QuestionRow(1 To TotalQ)
       
    With wsQuestions
'store selected question rows to array
        For Each cell In .Range(.Range("H2"), .Range("H" & .Rows.Count).End(xlUp)).Cells
            If UCase(cell.Value) = "A" Then i = i + 1: QuestionRow(i) = cell.Row
        Next
    End With
   
'get first question
    GetQuestion xlNext
End Sub

Updated code uses a dynamic array to store the user responses to the number of questions you set & output from this is posted to your worksheet. Also, with the addition of a back button, users can navigate back to a previous question if they want to review their response.



Hope Helpful



Dave

 

[Aswinraj]

@dmt32 its a great work thanks a lot sir. It works as i expected.

 

[dmt32]

@dmt32 its a great work thanks a lot sir. It works as i expected.

A rare thing for me these days but glad update does what you want

Many thanks for feedback

Dave