HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Open files, copy area under header, print to mastersheet

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
headeropenmastersheetunderfilesprintareacopy

Problem

This loops through folder to open files and get important info from the columns of names "HOLDER" and "CUTTING TOOL" and printing all the info to one excel document, masterfile.

It utilizes a dictionary and collection. I am very new to VBA So I do not know if I have stayed consistent with my naming of sheets and files and using the code to make the program work as fast as possible.

Any tips on how to streamline the code more?

```
Option Explicit

Sub LoopThroughDirectory()

Const ROW_HEADER As Long = 10

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim MyFolder As String
Dim StartSht As Worksheet, ws As Worksheet
Dim WB As Workbook
Dim i As Integer
Dim LastRow As Integer, erow As Integer
Dim Height As Integer
Dim RowLast As Long
Dim f As String
Dim dict As Object
Dim hc As Range, hc1 As Range, hc2 As Range, hc3 As Range, d As Range

Set StartSht = Workbooks("masterfile.xlsm").Sheets("Sheet1")

'turn screen updating off - makes program faster
Application.ScreenUpdating = False

'location of the folder in which the desired TDS files are
MyFolder = "C:\Users\trembos\Documents\TDS\progress\"

'find the headers on the sheet
Set hc1 = HeaderCell(StartSht.Range("B1"), "HOLDER")
Set hc2 = HeaderCell(StartSht.Range("C1"), "CUTTING TOOL")

'create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'get the folder object
Set objFolder = objFSO.GetFolder(MyFolder)
i = 2

'loop through directory file and print names
'(1)
For Each objFile In objFolder.Files
If LCase(Right(objFile.Name, 3)) = "xls" Or LCase(Left(Right(objFile.Name, 4), 3)) = "xls" Then
'(2)

'Open folder and file name, do not update links
Set WB = Workbooks.Open(fileName:=MyFolder & objFile.Name, UpdateLinks:=0)
Set ws = WB.ActiveSheet
'(3)
'find CUTTING TOOL on the source she

Solution

I've got the following points to make which are mostly about style and readability rather than the speed of the code.

  • Why not use early binding for the Microsoft Scripting Runtime? This will let declare variables such as FileSystemObject and as Dictionary rather than as Object.



  • Some of your functions do not state the return type, e.g. GetLastRowInSheet and GetLastRowInColumn should both return a Long I guess and GetValues should return a Dictionary.



  • Variable declaration. Personally, I always declare each variable on a separate line but if you want to condense them, then I'd suggest grouping them by type. In GetValues you mix variable types which makes it harder than it should to check the type of a variable.



  • Variable naming. Perhaps consider using more meaningful variable names. Dim d As Range doesn't really convey the meaning.



-
In the HeaderCell function you loop through cells looking at their value. If you use the Range.Find method it will probably be much quicker.

Function HeaderCell(rng As Range, sHeader As String) As Range
Set HeaderCell = rng.Parent.Range(rng, rng.Parent.Cells(rng.Row, Columns.Count).End(xlToLeft)) _
    .Find(What:=sHeader, LookIn:=xlValues, LookAt:=xlPartial, MatchCase:=True)
End Function


-
In the GetLastRowInSheet function you use the WorksheetFunction and Find methods. The former is quite slow. Consider using the UsedRange property of the Worksheet object.

Function GetLastRowInSheet(theWorksheet As Worksheet) As Long
    With theWorksheet.UsedRange
        GetLastRowInSheet = (.Row + .Rows.Count)
    End With
End Function


-
In your section (5) you've got With WB ... End With but I think it doesn't add much but increases the level of indentation.

Code Snippets

Function HeaderCell(rng As Range, sHeader As String) As Range
Set HeaderCell = rng.Parent.Range(rng, rng.Parent.Cells(rng.Row, Columns.Count).End(xlToLeft)) _
    .Find(What:=sHeader, LookIn:=xlValues, LookAt:=xlPartial, MatchCase:=True)
End Function
Function GetLastRowInSheet(theWorksheet As Worksheet) As Long
    With theWorksheet.UsedRange
        GetLastRowInSheet = (.Row + .Rows.Count)
    End With
End Function

Context

StackExchange Code Review Q#93002, answer score: 3

Revisions (0)

No revisions yet.