Help: Export specific data in a sheet in a new row

[sam]

Hi All,

I am trying this thing to work but its not working as I want.

Lets say I have a button "Export" on the userform, This userform has a
dropdown menu, which has student names, and selecting a student name from
that dropdown would populate other fields on the form such as, Name, Age,
Task etc..
So if i select Student1 from the dropdown, I will get the data of Student1
displayed on the form, If i select Student2 from the dropdown, I will get
data of Student2 displayed on the form.
Now when I click export, I want it to:
- open a file dialog box that lets me select another empty excel file
- once i select the excel file, i want the details of the select student to
be displayed in Row1
-If i select another student from the dropdown, i want the details of that
student to be displayed in Row2... and so on..
- Once I am done selecting the students, I want to manualy save the excel
file where I exported the student data.

Here is my code for the process:

Private Sub ExportToExcel_Click()

Dim exApp As Object
Dim exl As Object
Dim fdialog As FileDialog
Dim pathAndFile As String
Dim filePath As String
Dim shortName As String
Dim newWks As Workbook
Dim DestCell As Range
Dim FName As String

filePath = "C:\My Documents\Students.xls"

On Error Resume Next
Set exApp = GetObject(, "Excel.Application")

exApp.Visible = True

Set fdialog = exApp.FileDialog(msoFileDialogFilePicker)

With fdialog
.AllowMultiSelect = False
.Filters.Clear
.InitialFileName = filePath & "\*.xls*"

If .Show Then
pathAndFile = .SelectedItems(1)

shortName = Right(pathAndFile, _
Len(pathAndFile) - InStrRev(pathAndFile, "\"))
Else
MsgBox "User cancelled. Did not select a file"

End If
End With


Set newWks = exApp.Workbooks.Open(pathAndFile)


With newWks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

With DestCell
.Value = Me.Student_Id.Value
.Offset(0, 1).Value = Me.FirstName.Value
.Offset(0, 2).Value = Me.LastName.Value
End With


End Sub


Thanks in Advance

 

[Patrick Molloy]

you have this line
.InitialFileName = filePath & "\*.xls*"

but filepath is defined already as:
filePath = "C:\My Documents\Students.xls"
so suggest you use
filePath = "C:\My Documents"

you could use the
Application.GetOpenFilename
instead of dialog boxes, which you;ll file easier anyway.

there's also some confusion in your naming convention ie
Dim newWks As Workbook
so newWks is a workbook, but later you try to use it as a worksheet
i suggest

Dim newWks As WorkSheet
Dim newWkBk As Workbook

so change this
Set newWks = exApp.Workbooks.Open(pathAndFile)

to
Set newWkBk = exApp.Workbooks.Open(pathAndFile)

and add

Set newWks = newWkBk.Activesheet

your

With newWks

now refers to a worksheet objecty correctly

finally, before the END SUB add

newWkBk.Close TRUE
set newWks = Nothing
set newWkBk=Nothing
exApp.Quit
set exApp = Nothing

which closes AND save the workbook, then frees the memory



Finally, get rid of the ON ERROR RESUME NEXT
this "hides" errors fro your code so that you can't see whats happening
use ON ERROR GOTO errLine

then add
errLine:
and handle the error correctly.

 

[sam]

Thanks a lot for your help Patrick,

I made the changes you recommended, I am getting this error:

Set exApp = GetObject(, "Excel.Application")

On this line:

Set exApp = GetObject(, "Excel.Application")

Here is my code after your suggested changes:



Set exApp = GetObject(, "Excel.Application")

exApp.Visible = True

Set fdialog = exApp.FileDialog(msoFileDialogFilePicker)

With fdialog
.AllowMultiSelect = False
.Filters.Clear
.InitialFileName = filePath & "\*.xls*"

If .Show Then
pathAndFile = .SelectedItems(1)

shortName = Right(pathAndFile, _
Len(pathAndFile) - InStrRev(pathAndFile, "\"))
Else
MsgBox "User cancelled. Did not select a file"

End If
End With


Set newWkbk = exApp.Workbooks.Open(pathAndFile)

Set newWks = newWkbk.Sheets("Sheet1")


With newwks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

With DestCell
.Value = Me.Student_Id.Value
.Offset(0, 1).Value = Me.FirstName.Value
.Offset(0, 2).Value = Me.LastName.Value
End With

'newWkbk.Close True
Set newWks = Nothing
Set newWkbk = Nothing
'exApp.Quit
Set exApp = Nothing

End Sub

Thanks in Advance.

 

[sam]

Hey Patrick, I got it to work by doing this way:

On Error Resume Next
Set exApp = GetObject(, "Excel.Application")

If Err.Number <> 0 Then 'Excel isn't already running
Set exApp = CreateObject("Excel.Application")
End If
On Error GoTo 0

But another Issue I am having is: I want to keep on updating the excel sheet
such that It updates new record on a new row, Until I manually close the
file.. But rite now, It is closing the excel file after one update and when I
update it again, It overrites the previous row.. I have this statement to
populate the new data into the next available row "Set DestCell =
..Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)" But it updates the same row
everytime and overrites the previous row.

Set newWkbk = exApp.Workbooks.Open(pathAndFile) 'Open selected file

Set newWks = newWkbk.Sheets("Sheet1")


With newWks '.Sheets("Sheet1")
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

With DestCell
.Value = Me.Student_Id.Value
.Offset(0, 1).Value = Me.FirstName.Value
.Offset(0, 2).Value = Me.LastName.Value
End With

Thanks in Advance.

 

[sam]

Hey Patrick,

It kind of is looping through, but only when there is data in first cell of
the row. If the first cell is empty then it overrites the whole row, IF the
first cell has data it populates the next available row.. Is there a way to
fix this?

thanks in advance