Sub excelwrite()
Dim appExcel As Object
Dim wb As Object
Dim i As Integer
Dim j As Integer
i = 0
j = 1
Set appExcel = New Excel.Application
Set wb = appExcel.Workbooks.Open(ActivePresentation.Path +
"\y10chemistry1.xls")
'find the last empty row and add 1 to it
i = wb.Sheets("Sheet1").Range("A65536").End(xlUp).Row + 1
'first write the names to empty cell col A and B
wb.Sheets("Sheet1").Cells(i, 1) = userName1
wb.Sheets("Sheet1").Cells(i, 2) = userName2
'write answers from col C to end of array
For j = 1 To UBound(taggedAnswer)
wb.Sheets("Sheet1").Cells(i, j + 2) = taggedAnswer(j)
Next
wb.Close True
'release memory
Set wb = Nothing
Set appExcel = Nothing
End Sub
*** Sent via Developersdex
http://www.developersdex.com ***