PDA

View Full Version : Message Response Loop Problem



nsus
03-20-2009, 09:38 AM
I have written a piece of code that prompts the user for a data file location; then asks if the user wants to add another data file but the user does not need to select another file. Then the code opens the data file and copies over some information to the current worksheet.

My problems:

1) If the user does not want to add a second data sheet, the code still tried to open the file and gets hung up. I tried to deal with the statement: If DataSheet2<> "NoDataSet" Then. But it tried to open DataSheet 2 even if the user selected "no"

2)How can I close DataSheet1 and DataSheet2 when I have transfered the information?

My current problem code:

ThisSpreadsheet = "Lih_Data_import.xls"
Dim DataSet1 As Variant
Dim DataSet2 As Variant
Dim DataSet3 As Variant


DataSet1 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *xls", Title:="Choose Import Data File", MultiSelect:=False)
myMsg = "Do you want to select another file?"
Response = MsgBox(myMsg, vbYesNo, myTitle)
Select Case Response
Case Is = vbYes
DataSet2 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *xls", Title:="Choose Import Data File", MultiSelect:=False)
Case Is = vbNo
DataSet2 = "NoDataSet"
End Select


'Transfers REM5
'datasheet1
Workbooks.Open DataSet1
Sheets("REM5").Select
Range("A2:G2500").Copy
Windows(ThisSpreadsheet).Activate
Sheets("REM5").Select
Range("A5").PasteSpecial Paste:=xlPasteValues
FinalRow = Cells(65536, 1).End(xlUp).Row

'Datasheet2
If DataSheet2 <> "NoDataSet" Then
Workbooks.Open DataSet2
Sheets("REM5").Select
Range("A2:G2500").Copy
Windows(ThisSpreadsheet).Activate
Sheets("REM5").Select
FinalRow = Cells(65536, 1).End(xlUp).Row
Cells(FinalRow + 1, 1).PasteSpecial Paste:=xlPasteValues
End If

Bob Phillips
03-20-2009, 10:12 AM
untested



ThisSpreadsheet = "Lih_Data_import.xls"
Dim DataSet1 As Variant
Dim DataSet2 As Variant
Dim DataSet3 As Variant

DataSet1 = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *xls", _
Title:="Choose Import Data File", MultiSelect:=False)
myMsg = "Do you want to select another file?"
Response = MsgBox(myMsg, vbYesNo, myTitle)

Select Case Response
Case Is = vbYes
DataSet2 = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *xls", _
Title:="Choose Import Data File", MultiSelect:=False)

'Transfers REM5
'datasheet1
Workbooks.Open DataSet1
Sheets("REM5").Select
Range("A2:G2500").Copy
Windows(ThisSpreadsheet).Activate
Sheets("REM5").Select
Range("A5").PasteSpecial Paste:=xlPasteValues
FinalRow = Cells(65536, 1).End(xlUp).Row

'Datasheet2
If DataSheet2 <> "NoDataSet" Then
Workbooks.Open DataSet2
Sheets("REM5").Select
Range("A2:G2500").Copy
Windows(ThisSpreadsheet).Activate
Sheets("REM5").Select
FinalRow = Cells(65536, 1).End(xlUp).Row
Cells(FinalRow + 1, 1).PasteSpecial Paste:=xlPasteValues
End If
Case Is = vbNo
DataSet2 = "NoDataSet"
End Select

mdmackillop
03-20-2009, 10:16 AM
Welcome to VBAX

Sub Test()
Dim ThisWorkbook As Workbook
Dim WB As Workbook


Dim DataSet1 As Variant
Dim DataSet2 As Variant
Dim DataSet3 As Variant

Application.DisplayAlerts = False
Set ThisWorkbook = ActiveWorkbook

DataSet1 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *xls", Title:="Choose Import Data File", MultiSelect:=False)
myMsg = "Do you want to select another file?"
Response = MsgBox(myMsg, vbYesNo, myTitle)
Select Case Response
Case Is = vbYes
DataSet2 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *xls", Title:="Choose Import Data File", MultiSelect:=False)
End Select
'Transfers REM5
'datasheet1
Set WB = Workbooks.Open(DataSet1)
Sheets("REM5").Select
Range("A2:G2500").Copy
ThisWorkbook.Activate
Sheets("REM5").Select
Range("A5").PasteSpecial Paste:=xlPasteValues
FinalRow = Cells(65536, 1).End(xlUp).Row
WB.Close False
'Dataset2
If Not IsEmpty(DataSet2) Then
Set WB = Workbooks.Open(DataSet2)
Sheets("REM5").Select
Range("A2:G2500").Copy
ThisWorkbook.Activate
Sheets("REM5").Select
FinalRow = Cells(65536, 1).End(xlUp).Row
Cells(FinalRow + 1, 1).PasteSpecial Paste:=xlPasteValues
WB.Close , False
End If
Application.DisplayAlerts = True
End Sub

mdmackillop
03-20-2009, 10:21 AM
Neater for your Copy/Paste

'Transfers REM5
'datasheet1
Set WB = Workbooks.Open(DataSet1)
WB.Sheets("REM5").Range("A2:G2500").Copy
ThisWorkbook.Sheets("REM5").Range("A5").PasteSpecial Paste:=xlPasteValues
WB.Close False
'Dataset2
If Not IsEmpty(DataSet2) Then
Set WB = Workbooks.Open(DataSet2)
WB.Sheets("REM5").Range("A2:G2500").Copy
ThisWorkbook.Sheets("REM5").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
WB.Close , False
End If

nsus
03-23-2009, 11:26 AM
Thanks for the help. However, I am still getting an error at "Set WB = Workbooks.Open(DataSet2)" if a DataSet 2 is not selected. Any ideas on how I can get through this?

Thanks, N

mdmackillop
03-23-2009, 03:53 PM
This is what I'm running. I can't replicate your error.

Sub Test()
Dim ThisWorkbook As Workbook
Dim WB As Workbook

Dim DataSet1 As Variant
Dim DataSet2 As Variant
Dim DataSet3 As Variant
Application.DisplayAlerts = False
Set ThisWorkbook = ActiveWorkbook
DataSet1 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *xls", Title:="Choose Import Data File", _
MultiSelect:=False)
myMsg = "Do you want to select another file?"
Response = MsgBox(myMsg, vbYesNo, myTitle)
Select Case Response
Case Is = vbYes
DataSet2 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *xls", Title:="Choose Import Data File", _
MultiSelect:=False)
End Select
'Transfers REM5
'Dataset1
Set WB = Workbooks.Open(DataSet1)
WB.Sheets("REM5").Range("A2:G2500").Copy
ThisWorkbook.Sheets("REM5").Range("A5").PasteSpecial Paste:=xlPasteValues
WB.Close False
'Dataset2
If Not IsEmpty(DataSet2) Then
Set WB = Workbooks.Open(DataSet2)
WB.Sheets("REM5").Range("A2:G2500").Copy
ThisWorkbook.Sheets("REM5").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
WB.Close , False
End If
Application.DisplayAlerts = True
End Sub

mikerickson
03-23-2009, 10:10 PM
Another option is to eliminate the MsgBox. The user chooses files to open until they press Cancel on the GetOpenFileName dialog box.

Do While Not (Application.GetOpenFilename = False)
Rem some code
Loop