Here is code I wrote to concatenate data files into master file. Once the data to be pasted into the master sheet exceeds the number of rows left in the master sheet, the program will create a new master document and continue the process. Help me clean it up and make it faster if you can.
Option Explicit
Public NewMasterFile As Workbook
Public DataFile As Workbook
Public DataFilePath As String
Public DataFileName As String
Public FolderPath As FileDialog
Public eRow As Long
Public MasterFilePath As String
Dim myExtension As String
'Public i As Long
Public K As Long
Public R As Long
Public J As Long
Public A1 As String
Public B1 As String
Public C1 As String
Public D1 As String
Public cell As Range
Sub ConcatinateFiles()
On Error Resume Next
'Preset variables
J = 1
'i = 1
A1 = "SCEDTimestamp"
B1 = "RepeatedHourFlag"
C1 = "SettlementPoint"
D1 = "LMP"
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'Retrieve Target Master Workbook data folder Path From User
Set FolderPath = Application.FileDialog(msoFileDialogFolderPicker)
With FolderPath
.Title = "Select a master workbook data folder."
.AllowMultiSelect = False
If .Show <> -1 Then GoTo CancelSelect1
MasterFilePath = .SelectedItems(1) & "\"
End With
'In case Cancel selected
CancelSelect1:
MasterFilePath = MasterFilePath
If MasterFilePath = "" Then GoTo ResetSettings
'Retrieve Target Workbook data folder Path From User
Set FolderPath = Application.FileDialog(msoFileDialogFolderPicker)
With FolderPath
.Title = "Select a workbook data folder."
.AllowMultiSelect = False
If .Show <> -1 Then GoTo CancelSelect2
DataFilePath = .SelectedItems(1) & "\"
End With
'In case Cancel selected
CancelSelect2:
DataFilePath = DataFilePath
If DataFilePath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*" and ".xl??" the ? is a wildcard to search for all different types of excel files)
'myExtension = "*.csv"
'DataFileName = Dir(DataFilePath & myExtension)
DataFileName = Dir(DataFilePath)
Set NewMasterFile = Workbooks.Add
Set NewMasterFile = ActiveWorkbook
NewMasterFile.Worksheets(1).Activate
ActiveWorkbook.SaveAs FileName:=MasterFilePath & "Master_" & Format(Date, "ddmmmyyyy_") & J & ".xlsx"
'Open data file
Set DataFile = Workbooks.Open(DataFilePath & DataFileName)
'Select cells A1 to D1
Set DataFile = ActiveWorkbook
DataFile.Worksheets(1).Activate
Range("A1").Select
If IsEmpty(ActiveCell.Value) Then
ActiveCell.Value = A1
End If
Range("B1").Select
If IsEmpty(ActiveCell.Value) Then
ActiveCell.Value = B1
End If
Range("C1").Select
If IsEmpty(ActiveCell.Value) Then
ActiveCell.Value = C1
End If
Range("D1").Select
If IsEmpty(ActiveCell.Value) Then
ActiveCell.Value = D1
End If
'Change cursor so user knows the program is processing
Application.Cursor = xlWait
'New copy and paste (just set the values in the new workbook = to datafile values)
NewMasterFile.Worksheets("Sheet1").Range("A:D").Value = DataFile.ActiveSheet.Range("A:D").Value
'Save Master File
ActiveWorkbook.Save
'Save DataFile with incremental i value and close file
'DataFile.SaveAs filename:=DataFilePath & DataFileName & i & ".xlsx"
DataFile.Close
'i = i + 1
'Get next file name
DataFileName = Dir()
Do While DataFileName <> ""
'Call a subroutine here to count remaining blank cells left in column A
Call EmptyCellCount
Loop
'Reset Macro Optimization Settings
ResetSettings:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Message Box when tasks are completed
MsgBox "Task Complete!"
Application.Cursor = xlDefault
End Sub
Sub EmptyCellCount()
'This finds the last used row for copy destination
R = ActiveSheet.UsedRange.Rows.Count
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
'Count number of open cells left in column A of Master Workbook and store in variable K.
K = Selection.Rows.Count
'Number of rows of data from zipped data file.
If K <= 577 Then
'Save current Master Document, copy headers, close file.
ActiveWorkbook.Save
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveWorkbook.Close
'Create new Master Document, increment master file counter, and save
Set NewMasterFile = Workbooks.Add
Set NewMasterFile = ActiveWorkbook
NewMasterFile.Activate
J = J + 1
ActiveWorkbook.SaveAs FileName:=MasterFilePath & "Master_" & Format(Date, "ddmmmyyyy_") & J & ".xlsx"
'Paste Headers into new Master Document.
Range("A1:D1").Select
ActiveSheet.Paste
'Open current DataFileName selection, copy all data, paste into current MasterFile
'On Error Resume Next
'Open data file
Set DataFile = Workbooks.Open(DataFilePath & DataFileName)
'If Err.Number <> 0 Then
'MsgBox ("Unable to open file " & DataFileName)
'End If
'On Error GoTo 0
Set DataFile = ActiveWorkbook
DataFile.Worksheets(1).Activate
'Select all data on active worksheet from columns A2 to D2
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy Destination:=NewMasterFile.Worksheets(1).Cells(R + 1, 1)
'ActiveWorkbook.SaveAs filename:=DataFilePath & DataFileName & i & ".xlsx"
'Close the current data file
DataFile.Close
'i = i + 1
'Clear data stored on clipboard
Application.CutCopyMode = False
Set NewMasterFile = ActiveWorkbook
NewMasterFile.Worksheets(1).Activate
'Get next file name
DataFileName = Dir()
'Number of rows of data from zipped data file.
ElseIf K > 577 Then
'On Error Resume Next
'Open data file
Set DataFile = Workbooks.Open(DataFilePath & DataFileName)
'If Err.Number <> 0 Then
'MsgBox ("Unable to open file " & DataFileName)
'End If
'On Error GoTo 0
Set DataFile = ActiveWorkbook
DataFile.Worksheets(1).Activate
'Select all data on active worksheet from columns A2 to D2
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy Destination:=NewMasterFile.Worksheets(1).Cells(R + 1, 1)
'ActiveWorkbook.SaveAs filename:=DataFilePath & DataFileName & i & ".xlsx"
'Close the current data file
DataFile.Close
'i = i + 1
'Clear data stored on clipboard
Application.CutCopyMode = False
Set NewMasterFile = ActiveWorkbook
NewMasterFile.Worksheets(1).Activate
ActiveWorkbook.Save
'Get next file name
DataFileName = Dir()
End If
End Sub
-
\$\begingroup\$ There's only two subroutines, yes? And no functions, despite breaking a function out to a new sub? Why not just return what you need from a function and you won't need all those global variables \$\endgroup\$Raystafarian– Raystafarian2016年01月04日 18:07:07 +00:00Commented Jan 4, 2016 at 18:07
-
\$\begingroup\$ I'm new at coding apparently. So this program was what I was able to create so far. I seems to work when I test it. Can you direct me to better ways to make a program that does this? What do you mean by "Return what you need from a function"? \$\endgroup\$DKnight– DKnight2016年01月04日 20:39:37 +00:00Commented Jan 4, 2016 at 20:39
1 Answer 1
First things first.
Indentation and readability
It's extremely hard to read/follow the code, because the indentation is, well, inexistent. You've probably noticed some keywords come in pairs: Sub/End Sub
, If/End If
, With/End With
, Do/Loop
, ...there's a lot more, but the thing to remember is that these pairs form code blocks.
Some code blocks are special, they also define a scope - in VBA there are two levels of scope: module-level, and member-level. Sub
and Function
(and Property
, but we're not there yet) define a member-level scope.
Here's an example module:
Option Explicit
Private foo As Integer
Public Sub DoSomething()
If foo = 0 Then
foo = 42
Else
foo = GetFoo
End If
End Sub
Private Function GetFoo() As Integer
GetFoo = foo - 1
End Function
Notice the indentation makes it easy to quickly identify code blocks. Proper indentation is crucial if you want other people to be able to read your code... and "other people" includes yourself in a few weeks' time, too.
Scoping and visibility
Everything you've declared in the module's declarations section is scoped at module-level: all these variables are visible to everything in that module. Furthermore, anything at module-scope that you declare as Public
will also be visible to everything else in the project - in other words, a Public
field in a standard code module in VBA, is a global variable.
Consider this:
Option Explicit
Public Sub DoSomething()
Dim foo
foo = 42
End Sub
Public Sub DoSomethingElse()
Dim foo
foo = 12
End Sub
The two procedures define their own foo
variable. How is that possible? Each procedure has its own scope - in other words, foo
is a local variable and as such, it's a distinct variable in each procedure, that "dies" as soon as execution gets to End Sub
- they're also re-created as if they never existed, whenever the procedure gets called.
You want to avoid globals, and you want your variables as short-lived as possible - this makes the code easier to follow, and easier to maintain; your brain doesn't need to keep track of everything that's going on at once!
Parameters and return values
A good way to pass values around and to avoid global state, is to use parameters and return values. Consider:
Public Sub DoSomething()
Dim fn As String
fn = Range("A1").Value 'assumes cell contains a valid file name
Dim wb As Workbook
Set wb = OpenWorkbook(fn)
wb.Close
End Sub
Private Function OpenWorkbook(ByVal fileName As String) As Workbook
'fileName is a copy of the fn string from the calling code
Set OpenWorkbook = Workbooks.Open(fileName)
End Function
Of course this is just over-simplified example code, but you get the idea: OpenWorkbook
returns a Workbook
object that DoSomething
uses to do its thing. Variables are locally declared, and there's no need for any globals anywhere.
Error Handling.
If something can go wrong, Murphy's Law applies: that thing will end up going wrong at one point or another.
On Error Resume Next
This is your worst enemy. It's the devil incarnate: it makes you think everything is going well, and then your code starts not working as you would think it should be working, and you have no clue why, because it just keeps running: that instruction is telling VBA to take any runtime error that might happen, and ignore it completely.
Instead of shoving errors under the proverbial carpet, handle them!
Public Sub DoSomething
On Error GoTo CleanFail
'procedure body here
CleanExit:
'normal cleanup here
Exit Sub 'ensures error handler only runs on error!
CleanFail:
'handle runtime errors here
Resume CleanExit 'place breakpoint e.g. here, to debug
Resume 'jumps to the line that caused the error
End Sub
I've merely scratched the surface, but this answer is getting long enough. I would suggest you clean up what you have now (by fixing indentation, tightening variable lifetime and visibility, and handling runtime errors), and post a new follow-up question: it's easier to review code that's easier to read.
-
2\$\begingroup\$ Thanks for the feed back Muggle. I'll start working on those points you listed. Give me about a week or so and I'll have the corrections, I hope. Really appreciate the help and support. \$\endgroup\$DKnight– DKnight2016年01月06日 21:26:05 +00:00Commented Jan 6, 2016 at 21:26