Retrieve values from excel sheet

[tarun]

Try the below code

Code:

Set objExcel = CreateObject("Excel.Application")

objExcel.Workbooks.Open "c:/test.xls"

Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

'Declare a constant for total number of questions
Const QuesNo = 5

'Declare a constant for total number of possible answers
Const TotAns = 4

'Declare an array to store the number of results for a question
Dim aResults()

ReDim Preserve aResults(QuesNo - 1,TotAns - 1)

'Declare an array to store total number of a particular question
Dim aQues()

ReDim Preserve aQues(QuesNo - 1)

'Declare a dynamic array to store the percentages
Dim aResPer()

ReDim Preserve aResPer(QuesNo-1,TotAns-1)

'Initialize the arrays to 0 value
For i = 0 To QuesNo - 1
    aQues(i) = 0
    For j = 0 To TotAns - 1
        aResults(i,j) = 0
    Next
Next

Row_Count = 0
Loop_Control = True

Do While Loop_Control
    Row_Count = Row_Count + 1
    Loop_Control = True
    If objSheet.Cells(Row_Count,1) = "" Then
        Loop_Control = False
    End If
Loop

For j = 0 To QuesNo - 1
    For i = 2 To Row_Count - 1
        If CInt(objSheet.Cells(i,1)) = j + 1 Then
                Select Case CStr(objSheet.Cells(i,2))
                    Case "a"
                        aResults(j,0) = aResults(j,0) + 1
                    Case "b"
                        aResults(j,1) = aResults(j,1) + 1
                    Case "c"
                        aResults(j,2) = aResults(j,2) + 1
                    Case "d"
                        aResults(j,3) = aResults(j,3) + 1
                End Select                                                    
        End If
    Next                        
Next

For i = 0 To QuesNo - 1
    For j = 0 To TotAns - 1
        aQues(i) = aQues(i) + aResults(i,j)
    Next
Next

For i = 0 To QuesNo - 1
    For j = 0 To TotAns - 1
        aResPer(i,j) = (aResults(i,j)/aQues(i))*100
    Next
Next

Set objSheet = Nothing
'Write the results to new excel

objExcel.Workbooks.Add

Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "Results"

objSheet.Cells(1,1) = "QuestionNo"
objSheet.Cells(1,2) = "a%"
objSheet.Cells(1,3) = "b%"
objSheet.Cells(1,4) = "c%"
objSheet.Cells(1,5) = "d%"

For i = 2 To QuesNo + 1
    objSheet.Cells(i,1) = i - 1
Next

For i = 2 To QuesNo + 1
    For j = 2 To TotAns + 1
        objSheet.Cells(i,j) = aResPer(i-2,j-2)
    Next
Next

ObjExcel.ActiveWorkbook.SaveAs "c:\Results.xls", 56
ObjExcel.ActiveWorkbook.Close

objExcel.Application.Quit

Set objSheet = Nothing
Set objExcel = Nothing