trjhtr

The code imports 3 types of files, depending on the button selected. Something I might add is a check that the user has selected the right file - not too sure how I could do this.

I've been working on this code for about 2 weeks, and I've got it to a point where I'm happy. It's functional, copies data correctly, and allows my dashboard to operate so much quicker than before with manual updating.

I would like a critical review of my code for shortfalls and bad practices that I can cut out of any future programs, and any improvements I can make that help efficiency.

Sub GetFile(Fileoption As Integer)

Dim directory As String, sheet As Worksheet, total As Integer
 Dim fd As Office.FileDialog
 Dim filetype As Integer
 Dim fileurl As String
 Dim fdmulti As Boolean
 Dim fdButton As String
 Dim fdTitle As String
 Dim allList As Workbook
 Dim allName As String
 Dim importfile As Workbook
 Dim fileName As String
 Dim workrng As Range
 Dim myRange As Range
 Dim numRows As Integer
 Dim numCols As Integer
 Dim pcbdata As String 'Name of worksheet in PCB that contains project data
 Dim urlPCB As String
 Dim urlESO As String
 Dim urlGate As String
 Dim vrtSelectedItem As Variant


 'if error

'Set values for file dialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fdmulti = False
fdButton = "Import"
fdTitle = ""

> pcbdata = "name of sheet in workbook that contains data" ' NOTE - if name of sheet changes import will fail

'Set values for locations of files

urlPCB = "sharepoint file location url"
urlESO = "sharepoint file location url"
urlGate = "sharepoint file location url"
'File locations for PCB/ESO/GateReview

On Error GoTo Errorhandler

Select Case Fileoption 'Initialises FileDialog to open file for each specific case PCB/ESO/GateReview
 Case 1
 fileurl = urlPCB
 fdTitle = "Select PCB File"
 Case 2
 fileurl = urlESO
 fdTitle = "Select ESO File"
 Case 3
 fileurl = urlGate
 fdTitle = "Select Gate Review File"
 End Select

Set allList = ActiveWorkbook
allName = ActiveWorkbook.Name

 With fd ' uses the FileDialog box to find and open the file
 .Title = fdTitle
 .AllowMultiSelect = fdmulti
 .InitialFileName = fileurl
 .ButtonName = fdButton
 .InitialView = msoFileDialogViewDetails
 .Filters.Clear
 .Filters.Add "Excel Files", "*.csv ; *.xlsm ; *.xlsx", 1

 If .Show = True Then 'initiates FileDialog Box
 For Each vrtSelectedItem In .SelectedItems 'Opens selected file from Local/Ensemble directory
 Workbooks.Open (vrtSelectedItem)
 Next
 End If

 If .SelectedItems.Count = 0 Then 'if user selects Cancel
 MsgBox "File selection cancelled"
 Exit Sub
 End If
 End With

 fileName = ActiveWorkbook.Name 'Saves the opened file's name for later reference
 Set importfile = ActiveWorkbook 'Saves Wookbook object for potential use


 'Turns off automatic updates for formulas to make the process faster
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False


 Select Case Fileoption ' copies relevant data depending on type of file opened
 Case 1
 Windows(allName).Activate ' Clears PCB data sheet in Comparison workbook
 Sheets("PCB Data").Activate
 On Error Resume Next
 selectBlock().ClearContents
 On Error GoTo Errorhandler

 Windows(fileName).Activate ' Copy and pastes data from PCB All projects list
 Sheets(pcbdata).Activate
 selectBlock().Copy

 Windows(allName).Activate
 Sheets("PCB Data").Range("A2").PasteSpecial (xlPasteValues)

 ActiveWorkbook.Saved = True
 Windows(fileName).Close savechanges:=False

 MsgBox "PCB projects Imported"
 Case 2
 Windows(allName).Activate ' Clears ESO data sheet in Comparison workbook
 Sheets("ESO Data").Activate
 On Error Resume Next
 selectBlock().Clear
 On Error GoTo Errorhandler

 Windows(fileName).Activate
 Dim ws As Worksheet ' Runs through all worksheets

 For Each ws In ActiveWorkbook.Worksheets
 'repeat copy paste for each sheet in the ESO file
 Windows(fileName).Activate
 ws.Activate
 selectBlock().Copy

 Windows(allName).Activate
 Sheets("ESO Data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteAll)
 Next
 ActiveWorkbook.Saved = True
 Windows(fileName).Close savechanges:=False

 MsgBox "ESO data Imported"
 Case 3
 Windows(allName).Activate ' Clears Gate Review data sheet in Comparison workbook
 Sheets("Gate Review").Activate
 On Error Resume Next
 selectBlock().Clear
 On Error GoTo Errorhandler

 Windows(fileName).Activate ' Copy and pastes data from Gate Review file
 selectBlock().Copy

 Windows(allName).Activate
 Sheets("Gate Review").Range("A2").PasteSpecial (xlPasteAll)

 Windows(fileName).Activate
 Sheets("Confirmed Closed Projects ").Activate
 selectBlock().Copy

 Windows(allName).Activate
 Sheets("Gate Review").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteAll)

 ActiveWorkbook.Saved = True
 Windows(fileName).Close savechanges:=False

 MsgBox "Gate review Imported"
 End Select

 Sheets("Tools").Activate
 Cells(2, 1).Select

 'Turns back on automaic updates for formulas
 Application.ScreenUpdating = True
 Application.DisplayAlerts = True

 Exit Sub

Errorhandler: ' catches the error when no file is selected or any other error
 If Err.Number = 1004 Then
 MsgBox "File selection cancelled"
 Else
 MsgBox Err.Description
 End If

End Sub

Supporting Code Subs and Functions

Function PCB(num As Integer) As Integer ' Handles which type of file is wanted
GetFile (num)

End Function

Sub ButtonPCB()
' PCB button
PCB (1)
End Sub

Sub ButtonESO()
' ESO button
PCB (2)
End Sub

Sub GateReview()
PCB (3) ' Gate Review button
End Sub

Function selectBlock() As Range

Dim row As Long: row = numRows() 'Finds last populated row
Dim col As Long: col = numCols() 'Finds last populated column

Set selectBlock = Range("A2:" & ActiveSheet.Cells(row, col).Address(False, False))
'sets this area starting from cell A2 as the Range

End Function

Function numCols() As Long

 'Dim myRange As Range
 'Set myRange = ActiveSheet.Range("1:1") 'Checks first row to see how many populated columns there are
 numCols = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column

End Function

Function numRows() As Long
 'Dim myRange As Range
 'Set myRange = ActiveSheet.Range("A:A") 'Checks first columns to see how many populated rows there are
 numRows = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).row

End Function

Option Explicit

You've declared all your variable, yay! But you should put Option Explicit at the top in case you forget. Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

I'm going to assume this line is just a typo, there's no reason for the ">" and it breaks the procedure

> pcbdata = "name of sheet in workbook that contains data" ' NOTE - if name of sheet changes import will fail

Flow

So a user clicks one of three buttons and that sends an argument to your "GetFile". This sends an argument to Function PCB which then calls GetFile with an argument. But your PCB function doesn't return anything anywhere, it's an extra step. Just eliminate it entirely.

Once that argument goes to GetFile you set three different URLs to strings and then Select Case on them -

urlPCB = "sharepoint file location url"
urlESO = "sharepoint file location url"
urlGate = "sharepoint file location url"
Select Case Fileoption 'Initialises FileDialog to open file for each specific case PCB/ESO/GateReview
 Case 1
 fileurl = urlPCB
 fdTitle = "Select PCB File"
 Case 2
 fileurl = urlESO
 fdTitle = "Select ESO File"
 Case 3
 fileurl = urlGate
 fdTitle = "Select Gate Review File"
 End Select

Usually I'd say make the URLs constants, but in this case just place them directly in the Select Case because you aren't using them again.

Then you start the file dialog, but I'm not sure why you have the

If .Show = True Then

oh wait yes I do, it's the example everywhere

Just .Show it. As a side note, when you if test a boolean, you don't need to put = True because it is true. If .Show Then. So if you get rid of that, your For Each vrtSelectItem will run, but not cause any errors because it's running over nothing. Your next If will catch that error. But, if a user hits Cancel they don't need to be told, IMHO. So just catch the error explicitly -

.Show 
If .SelectedItems.Count = 0 Then Exit Sub
For Each vrtSelectedItem In .SelectedItems 
 Workbooks.Open (vrtSelectedItem)
Next

Or if you want

If Not .Show Then Exit Sub

Good. But now you are getting the ActiveWorkbook.Name of whatever was opened last. It would be better to get those earlier with a Workbooks collection:

For i = 1 To .SelectedItems.Count
 myWorkbooks.Add .SelectedItems(i)
Next

But, you don't allow multiselect:

fdmulti = False
 With fd 
 .Title = fdTitle
 .AllowMultiSelect = fdmulti

So you don't need a collection, you just need a single workbook

Dim targetWorkbook as Workbook
Set targetWorkbook = Workbooks.Open .SelectedItems(1)

Now you have that workbook in a variable. Also, now you don't need to do all this .Activate - you know what sheet and how to get the range. And, correct me if I'm wrong, right now you're taking all the sheets. So

If Not .Show Then Exit Sub
 Set targetWorkBook = Workbooks.Open(.SelectedItems(1))
 For i = 1 To targetWorkBook.Sheets.Count
 ThisWorkbook.Sheets(i).Copy before:=targetWorkBook.Sheets(1)
 Next

Or some such stuff, I may have the books backwards or I may be misunderstanding it. Either way you get the idea, if you know what sheet to get, just do this part in your Select Case.

selectBlock() As Range

What argument is this taking? Right now you use ThisWorkbook.ActiveSheet. Be explicit about what you want -

Private Function GetCells(ByVal targetSheet As Worksheet) As Range
 Dim lastRow As Long
 Dim lastColumn As Long
 lastRow = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).row
 lastColumn = targetSheet.Cells(1, targetSheet.Columns.Count).End(xlToLeft).Column
 Set GetCells = targetSheet.Range(targetSheet.Cells(2, 1), targetSheet.Cells(lastRow, lastColumn))
End Function

In this case I don't think you need to break out the last row and last column functions, they are one line. However, if you're already taking the sheets you need and copying them, you have no reason for this, unless you're doing something else to them later.

Function Arguments

So I touched on it briefly - Functions should be used when something is returned and subs should be used when something happens.

You also want to take all your parameters ByVal instead of ByRef, which it's doing implicitly when you don't tell it.

Also you're using integerinstead of Long - Integers - integers are obsolete. According to msdn VBA silently converts all integers to long.

Handling Errors

On Error Resume Next
selectBlock().ClearContents
On Error GoTo Errorhandler

So you want to plow right over any errors and then go back to error checking? Handle those errors! When you throw to an error handler, you have the err.Number, which you know, so just throw that at the user. And use this type of format -

CleanExit:
 Application.ScreenUpdating = True
 Exit Sub

CleanFail:
 CustomErrorHandler Err
 Resume CleanExit
End Sub

What you're doing will work, but it might be better to do it this way.

Constants

One thing I notice is that you have a lot of prompt dialog. Think about taking all those into string constants at the top and using that variable instead of typing them out everywhere, it just seems clearner

Some quick comments.

In VBA, don't use () for left hand calls to subroutines. i.e. use PCB 2 instead of PCB (2). Not a big issue in this case, but the () actually means something in VBA and pre-evaluates expressions.

You don't need to .Activate your windows. For starters, you already have turned ScreenUpdating off (for good reason). Explicitly address your ranges

Windows(fileName).Activate
ws.Activate
selectBlock().Copy

Can become

selectblock(fileNameWB.ws).Copy

Because you also get rid of ActiveSheet from selectblock:

Function selectBlock(ws as worksheet) As Range
 Dim row As Long: row = numRows() 'Finds last populated row
 Dim col As Long: col = numCols() 'Finds last populated column
 Set selectBlock = Range("A2:" & ws.Cells(row, col).Address(False, False))
 'sets this area starting from cell A2 as the Range
End Function

but your selectBlock function is really ws.UsedRange.Offset(1,0). That is, everything bar the first row. This also means that you don't need the helper functions numrows or numcols.

You open multiple workbooks in your dialog, but you don't explicitly address each workbook.

Your use of On Error should be reconsidered. Plan for some errors and handle them in the code. Using functions like UsedRange will prevent some errors so you don't have to Resume Next. Ideally, you should not use On Error at all, particularly in a coding example like you have here.