patternMinor
Get data from user input as workbook or worksheet
Viewed 0 times
workbookuserinputgetworksheetfromdata
Problem
I had two different functions for populating a data array. I tried to refactor them using a single argument as to whether or not the user should be selecting a worksheet or just the workbook.
The primary issue being whether I need to prompt the user to select a range or not. The main difference between the two before was if using just a sheet I didn't need
I came at the refactoring a little backwards, so I imagine it can be improved.
```
Option Explicit
Private Function ImportDataFromExternalSource(ByVal pickSheet As Boolean, Optional ByVal numberOfColumns As Long = 0) As Variant
Dim lastRow As Long
Dim fileName As String
Dim xlApp As New Application
Set xlApp = New Excel.Application
Dim targetBook As Workbook
Dim targetSheet As Worksheet
Dim targetDataRange As Range
On Error GoTo ErrorHandler
fileName = File_Picker
Set targetBook = xlApp.Workbooks.Open(fileName)
Set targetSheet = targetBook.Sheets(1)
If pickSheet Then
xlApp.ActiveWorkbook.Windows(1).Visible = True
xlApp.Visible = True
targetBook.Activate
targetBook.Sheets(1).Activate
Set targetDataRange = xlApp.InputBox("Pick a cell on the sheet you would like to import", Type:=8)
Set targetSheet = targetDataRange.Parent
End If
If numberOfColumns = 0 Then numberOfColumns = targetSheet.Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = targetSheet.Cells(Rows.Count, 1).End(xlUp).Row
ImportDataFromExternalSource = targetSheet.Range(targetSheet.Cells(1, 1), targetSheet.Cells(lastRow, numberOfColumns))
CleanExit:
If pickSheet Then
xlApp.Quit
Exit Function
End If
ThisWorkbook.Activate
targetBook.Close
Exit Function
ErrorHandler:
MsgBox "you've cancelled"
Resume CleanExit
End Function
Public Function File_Picker() As String
Dim workbookName As String
Dim selectFile As FileDialog
Set selectFile = Application.FileDialog(msoFileDialogOpen
The primary issue being whether I need to prompt the user to select a range or not. The main difference between the two before was if using just a sheet I didn't need
xlApp.I came at the refactoring a little backwards, so I imagine it can be improved.
```
Option Explicit
Private Function ImportDataFromExternalSource(ByVal pickSheet As Boolean, Optional ByVal numberOfColumns As Long = 0) As Variant
Dim lastRow As Long
Dim fileName As String
Dim xlApp As New Application
Set xlApp = New Excel.Application
Dim targetBook As Workbook
Dim targetSheet As Worksheet
Dim targetDataRange As Range
On Error GoTo ErrorHandler
fileName = File_Picker
Set targetBook = xlApp.Workbooks.Open(fileName)
Set targetSheet = targetBook.Sheets(1)
If pickSheet Then
xlApp.ActiveWorkbook.Windows(1).Visible = True
xlApp.Visible = True
targetBook.Activate
targetBook.Sheets(1).Activate
Set targetDataRange = xlApp.InputBox("Pick a cell on the sheet you would like to import", Type:=8)
Set targetSheet = targetDataRange.Parent
End If
If numberOfColumns = 0 Then numberOfColumns = targetSheet.Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = targetSheet.Cells(Rows.Count, 1).End(xlUp).Row
ImportDataFromExternalSource = targetSheet.Range(targetSheet.Cells(1, 1), targetSheet.Cells(lastRow, numberOfColumns))
CleanExit:
If pickSheet Then
xlApp.Quit
Exit Function
End If
ThisWorkbook.Activate
targetBook.Close
Exit Function
ErrorHandler:
MsgBox "you've cancelled"
Resume CleanExit
End Function
Public Function File_Picker() As String
Dim workbookName As String
Dim selectFile As FileDialog
Set selectFile = Application.FileDialog(msoFileDialogOpen
Solution
This is a cleaned-up version I would suggest:
Being called like this:
If you are interested in the reasons behind the changes I made, I can provide some detailed information if you like.
Issues that still needs to be addressed
-
It would be preferable to decouple the user interaction (file and sheet selection) from the import logic, known as the Model-view-controller pattern. Have one function asking the user for the file and (optionally) the sheet, returning a
This way you are more flexible if, for example, you decide at one point that the sheet should also be able to be automatically retrieved by some other means. Just implement that in a way that it returns a
-
The way you determine the last cell in the sheet will fail in some circumstances (e.g. if the sheet is empty). Have a look at https://stackoverflow.com/a/11169920/6216216 for a thourough discussion of more robust alternatives.
Notes on Error Handling
You switched error handling on at the beginning of the function - as it is often recommended. There is no good way to do proper error handling in VBA (one of VBA's bigger flaws), but I thoroughly dislike the variant of catching all errors and handling them in one monolithic error handling routine at the end of the function/sub.
This is why:
Especially the second issue can become a serious problem when you start handling unexpected errors the same way as expected errors, since the error handling routine has no way to tell them apart.
Exactly this happened in your original code: If you call
Option Explicit
Private Function ImportDataFromExternalSource(ByVal boolPickSheet As Boolean, Optional ByVal lngNumberOfColumns As Long = 0) As Variant
Dim lngLastRow As Long
Dim strFileName As String
Dim xlApp As New Excel.Application
Dim wbkTarget As Excel.Workbook
Dim shtTarget As Excel.Worksheet
' ask the user to select a file and try to open it with Excel
Set xlApp = New Excel.Application
Do While wbkTarget Is Nothing
strFileName = FilePicker()
If strFileName = "" Then Exit Function ' user requested abort
On Error Resume Next
Set wbkTarget = xlApp.Workbooks.Open(strFileName)
If Err <> 0 Then MsgBox "An error occurred while opening the file" & vbNewLine _
& strFileName & vbNewLine _
& vbNewLine _
& Err.Description _
, vbCritical
On Error GoTo 0
Loop
Set shtTarget = wbkTarget.Sheets(1)
' let the user select the sheet to import from
If boolPickSheet Then
xlApp.Visible = True
Set shtTarget = xlApp.InputBox("Pick a cell on the sheet you would like to import", Type:=8).Parent
End If
' determine the data that should be imported
If lngNumberOfColumns = 0 Then lngNumberOfColumns = shtTarget.Cells(1, Columns.Count).End(xlToLeft).Column
lngLastRow = shtTarget.Cells(Rows.Count, 1).End(xlUp).Row
ImportDataFromExternalSource = shtTarget.Range(shtTarget.Cells(1, 1), shtTarget.Cells(lngLastRow, lngNumberOfColumns)) ' convert Range to Array
' cleanup
wbkTarget.Close False
xlApp.Quit
End Function
Public Function FilePicker() As String
With Excel.Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Title = "Select the file with your data."
.Filters.Clear
.Filters.Add "Excel Document", ("*.csv, *.xls*")
.InitialView = msoFileDialogViewDetails
If .Show Then FilePicker = .SelectedItems(1)
End With
End FunctionBeing called like this:
Public Sub Test()
Dim x As Variant
x = ImportDataFromExternalSource(False, 1)
If IsEmpty(x) Then
MsgBox "you've cancelled", vbInformation
Else
Debug.Print x(1)
End If
End SubIf you are interested in the reasons behind the changes I made, I can provide some detailed information if you like.
Issues that still needs to be addressed
-
It would be preferable to decouple the user interaction (file and sheet selection) from the import logic, known as the Model-view-controller pattern. Have one function asking the user for the file and (optionally) the sheet, returning a
Worksheet object. Now you can feed that object to another function that retrieves the array from the given sheet. This way you are more flexible if, for example, you decide at one point that the sheet should also be able to be automatically retrieved by some other means. Just implement that in a way that it returns a
Worksheet object, and you are good to go.-
The way you determine the last cell in the sheet will fail in some circumstances (e.g. if the sheet is empty). Have a look at https://stackoverflow.com/a/11169920/6216216 for a thourough discussion of more robust alternatives.
Notes on Error Handling
You switched error handling on at the beginning of the function - as it is often recommended. There is no good way to do proper error handling in VBA (one of VBA's bigger flaws), but I thoroughly dislike the variant of catching all errors and handling them in one monolithic error handling routine at the end of the function/sub.
This is why:
- The handling of an error gets disconnected from the origin of the error. This makes the code harder to read and easier to mess up during maintanance. Furthermore, debugging becomes a pain.
- You may cast too broad a net, you might catch errors that you didn't want to catch.
Especially the second issue can become a serious problem when you start handling unexpected errors the same way as expected errors, since the error handling routine has no way to tell them apart.
Exactly this happened in your original code: If you call
ImportDataFromExternalSource(False) and you cancel the file picker, fileName contains the empty string "". Trying to open that as an Excel workbook will fail and the error handler is called. This seems to be expected, because a message is displayed and the program gracefully terminated by jumping to the CleanExit label. During cleanup however, targetBook.Close is called, which will fail, because there is no targetBook, and an unexpected error is raised. Since your error handler cannot distinguish this from the expected error, the same routine is called: the messagebox is displayed again, the code continues with the CleanExit label and... now you are stuck in an infinite loop, becauCode Snippets
Option Explicit
Private Function ImportDataFromExternalSource(ByVal boolPickSheet As Boolean, Optional ByVal lngNumberOfColumns As Long = 0) As Variant
Dim lngLastRow As Long
Dim strFileName As String
Dim xlApp As New Excel.Application
Dim wbkTarget As Excel.Workbook
Dim shtTarget As Excel.Worksheet
' ask the user to select a file and try to open it with Excel
Set xlApp = New Excel.Application
Do While wbkTarget Is Nothing
strFileName = FilePicker()
If strFileName = "" Then Exit Function ' user requested abort
On Error Resume Next
Set wbkTarget = xlApp.Workbooks.Open(strFileName)
If Err <> 0 Then MsgBox "An error occurred while opening the file" & vbNewLine _
& strFileName & vbNewLine _
& vbNewLine _
& Err.Description _
, vbCritical
On Error GoTo 0
Loop
Set shtTarget = wbkTarget.Sheets(1)
' let the user select the sheet to import from
If boolPickSheet Then
xlApp.Visible = True
Set shtTarget = xlApp.InputBox("Pick a cell on the sheet you would like to import", Type:=8).Parent
End If
' determine the data that should be imported
If lngNumberOfColumns = 0 Then lngNumberOfColumns = shtTarget.Cells(1, Columns.Count).End(xlToLeft).Column
lngLastRow = shtTarget.Cells(Rows.Count, 1).End(xlUp).Row
ImportDataFromExternalSource = shtTarget.Range(shtTarget.Cells(1, 1), shtTarget.Cells(lngLastRow, lngNumberOfColumns)) ' convert Range to Array
' cleanup
wbkTarget.Close False
xlApp.Quit
End Function
Public Function FilePicker() As String
With Excel.Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Title = "Select the file with your data."
.Filters.Clear
.Filters.Add "Excel Document", ("*.csv, *.xls*")
.InitialView = msoFileDialogViewDetails
If .Show Then FilePicker = .SelectedItems(1)
End With
End FunctionPublic Sub Test()
Dim x As Variant
x = ImportDataFromExternalSource(False, 1)
If IsEmpty(x) Then
MsgBox "you've cancelled", vbInformation
Else
Debug.Print x(1)
End If
End SubContext
StackExchange Code Review Q#155616, answer score: 4
Revisions (0)
No revisions yet.