patternMinor
Copying data entry values in to a separate WorkFile
Viewed 0 times
entryworkfileseparatecopyingvaluesdata
Problem
The code is working but slow. Is there a way to speed it up or make it more compact but still easy to read?
There are 35 different jobs to be done. They are made in a worksheet with merged cells to enter, who did the job, when, how long, workorder, nr, etc. Next to the layout is a command button, and when you click on it, it will copy all the values to a list in another WorkFile.
Here is the second command button:
```
Private Sub CommandButton3_Click()
GetBook = ActiveWorkbook.Name
Application.ScreenUpdating = False
Call OpenFile
Call ReadOnly
Call FindLastRow
Set rng = Worksheets("PHASE").Range("N18:O21")
With CommandButton3
.Caption = "Is al Ingegeven"
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Heig
There are 35 different jobs to be done. They are made in a worksheet with merged cells to enter, who did the job, when, how long, workorder, nr, etc. Next to the layout is a command button, and when you click on it, it will copy all the values to a list in another WorkFile.
Private Sub CommandButton2_Click()
GetBook = ActiveWorkbook.Name
Application.ScreenUpdating = False
Call OpenFile
Call ReadOnly
Call FindLastRow
Set rng = Worksheets("PHASE").Range("N13:O16")
With CommandButton2
.Caption = "Is al Ingegeven"
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
.WordWrap = True
End With
'Tail Nummer
Windows(GetBook).Activate
Range("A1").Select
Call CopyTailNum
'Datum
Windows(GetBook).Activate
Range("B14").Select
Call CopyDate
'Naam
Windows(GetBook).Activate
Range("B16").Select
Call CopyNaam
'Werk
Windows(GetBook).Activate
Range("A13").Select
Call CopyWerk
'Start Uur
Windows(GetBook).Activate
Range("E14").Select
Call CopyStartUur
'Eind Uur
Windows(GetBook).Activate
Range("E15").Select
Call CopyEindUur
'Remarks
Windows(GetBook).Activate
Range("H16").Select
Call CopyRemarks
'WOnr
Windows(GetBook).Activate
Range("K13").Select
Call CopyWONr
Call UpdateTable
Workbooks("StartBlad.xlsm").Save
Windows(GetBook).Activate
Application.ScreenUpdating = True
Call UpdateMessage
End SubHere is the second command button:
```
Private Sub CommandButton3_Click()
GetBook = ActiveWorkbook.Name
Application.ScreenUpdating = False
Call OpenFile
Call ReadOnly
Call FindLastRow
Set rng = Worksheets("PHASE").Range("N18:O21")
With CommandButton3
.Caption = "Is al Ingegeven"
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Heig
Solution
The first thing I noticed about the posted code was that it was very easy to follow.
A structure that allowed to identify elements, flow, and more importantly, patterns
One note about indentation: all code in a Sub() or Function() should be indented one level, and the inner blocks should have increased levels of indentation accordingly
The next obvious thing I noticed was the use of
Another inefficiency is to re-position the command buttons at every click. The positional anchor (range) is always the same so they're basically static, but if you need to make sure they have a consistent position it would be reasonable to reset them once, when the file first opens. The only reason for buttons to move is if a user goes into Design Mode and drags them somewhere else (not likely in normal usage)
Related to code size, the two Click() subs have an identical structure except for the ranges. You don't need to extract
The most generic code usually doesn't have ANY hard-coded values: all references to ranges, file names and paths, messages (all strings in general), and all numeric values should be defined as constants, within the most limited scope (private to the block, Sub \ Function, or Module level). Hard-coded values are causing most of the unnecessary maintenance effort, especially when the same values are used in multiple places
You are using
The repetitive and unnecessary processing continues in both Click() events:
All these calls can be moved to the one-time processing of
"WorkFileTable" in StartBlad.xlsm file doesn't need to be re-sized: you first determine the last row, then copy the new values into the previous range, without adding or removing rows
Combining the items above you would get the click events similar to this:
(I'm not sure what
Moving to the called subs section, all Copy*() subs are identical and can be combined into one sub that takes 2 parameters - copyFrom and copyTo as ranges
The following actions have been replaced by a direct copy of values:
(probably this is where most processing time was spent)
All Subs() and Functions should be explicitly defined as Public or Private, to show your intent. Excel defaults to Public scope and that's bad coding practice - it should default to Private but this would confuse inexperienced programmers, so in a way is a more forgiving behavior intended not to discourage or overwhelm
The last note is about Function
```
Public Function getWorkBook(ByVal wbName As String) As Workbook
Dim wb As Workbook
For Each wb In Application.Workbooks
If wb.Name = wbName Then
Set getWorkBook = wb
Exit F
A structure that allowed to identify elements, flow, and more importantly, patterns
One note about indentation: all code in a Sub() or Function() should be indented one level, and the inner blocks should have increased levels of indentation accordingly
The next obvious thing I noticed was the use of
.Activate and .Select which triggered inefficiency warnings: .Select is never needed and it's the slowest of the two, .Activate might be needed on very rare occasions but for most operations it's not, so these would be the first improvements to be applied to more than 90% of the codeAnother inefficiency is to re-position the command buttons at every click. The positional anchor (range) is always the same so they're basically static, but if you need to make sure they have a consistent position it would be reasonable to reset them once, when the file first opens. The only reason for buttons to move is if a user goes into Design Mode and drags them somewhere else (not likely in normal usage)
Related to code size, the two Click() subs have an identical structure except for the ranges. You don't need to extract
ActiveWorkbook.Name with every click, so this can be moved to the Workbook_Open() event where a limited set of global variables can keep a reference to the two working files and their main worksheetsThe most generic code usually doesn't have ANY hard-coded values: all references to ranges, file names and paths, messages (all strings in general), and all numeric values should be defined as constants, within the most limited scope (private to the block, Sub \ Function, or Module level). Hard-coded values are causing most of the unnecessary maintenance effort, especially when the same values are used in multiple places
You are using
Application.ScreenUpdating well - turn it off before, then back on. You should keep in mind though, that if the code errors out at any point in between, users will be confused when Excel doesn't refresh the screen properly because it wasn't able to turn this setting back on.The repetitive and unnecessary processing continues in both Click() events:
Call OpenFile
Call ReadOnly
Set rng = Worksheets("PHASE").Range("N13:O16")- Check if the file is open (every click)
- Check if the file is read-only (every click)
- Set
rngto Worksheets("PHASE").Range("N13:O16") (every click)
All these calls can be moved to the one-time processing of
Workbook_Open()Call UpdateTable"WorkFileTable" in StartBlad.xlsm file doesn't need to be re-sized: you first determine the last row, then copy the new values into the previous range, without adding or removing rows
Combining the items above you would get the click events similar to this:
Private Sub Update1() 'CommandButton2_Click()
Dim lastCell As Range, lastRow As Long
lastRow = GetMaxCell(wsWorkFile).Row
If lastRow > 1 Then
Application.ScreenUpdating = False
With wsPhase
CopyData .Range(TAIL_NUMMER_1), wsWorkFile.Range("A" & lastRow + 1)
CopyData .Range(DATUM_1), wsWorkFile.Range("B" & lastRow + 1)
CopyData .Range(NAAM_1), wsWorkFile.Range("C" & lastRow + 1)
CopyData .Range(WERK_1), wsWorkFile.Range("D" & lastRow + 1)
CopyData .Range(START_UUR_1), wsWorkFile.Range("E" & lastRow + 1)
CopyData .Range(EIND_UUR_1), wsWorkFile.Range("F" & lastRow + 1)
CopyData .Range(REMARKS_1), wsWorkFile.Range("G" & lastRow + 1)
CopyData .Range(WONR_1), wsWorkFile.Range("H" & lastRow + 1)
End With
Application.ScreenUpdating = True
'Call UpdateMessage 'this is missing from initial code...
End If
End Sub(I'm not sure what
UpdateMessage is)Moving to the called subs section, all Copy*() subs are identical and can be combined into one sub that takes 2 parameters - copyFrom and copyTo as ranges
Sub CopyData(ByRef fromRange As Range, ByRef toRange As Range)
toRange.Value2 = fromRange.Value2
End SubThe following actions have been replaced by a direct copy of values:
- .Copy
- .Activate
- .Select
- .PasteSpecial Paste:=xlPasteValues
(probably this is where most processing time was spent)
All Subs() and Functions should be explicitly defined as Public or Private, to show your intent. Excel defaults to Public scope and that's bad coding practice - it should default to Private but this would confuse inexperienced programmers, so in a way is a more forgiving behavior intended not to discourage or overwhelm
The last note is about Function
WorkbookOpen. It relies on expected errors instead of properly detecting if the file is open or not:```
Public Function getWorkBook(ByVal wbName As String) As Workbook
Dim wb As Workbook
For Each wb In Application.Workbooks
If wb.Name = wbName Then
Set getWorkBook = wb
Exit F
Code Snippets
Call OpenFile
Call ReadOnly
Set rng = Worksheets("PHASE").Range("N13:O16")Call UpdateTablePrivate Sub Update1() 'CommandButton2_Click()
Dim lastCell As Range, lastRow As Long
lastRow = GetMaxCell(wsWorkFile).Row
If lastRow > 1 Then
Application.ScreenUpdating = False
With wsPhase
CopyData .Range(TAIL_NUMMER_1), wsWorkFile.Range("A" & lastRow + 1)
CopyData .Range(DATUM_1), wsWorkFile.Range("B" & lastRow + 1)
CopyData .Range(NAAM_1), wsWorkFile.Range("C" & lastRow + 1)
CopyData .Range(WERK_1), wsWorkFile.Range("D" & lastRow + 1)
CopyData .Range(START_UUR_1), wsWorkFile.Range("E" & lastRow + 1)
CopyData .Range(EIND_UUR_1), wsWorkFile.Range("F" & lastRow + 1)
CopyData .Range(REMARKS_1), wsWorkFile.Range("G" & lastRow + 1)
CopyData .Range(WONR_1), wsWorkFile.Range("H" & lastRow + 1)
End With
Application.ScreenUpdating = True
'Call UpdateMessage 'this is missing from initial code...
End If
End SubSub CopyData(ByRef fromRange As Range, ByRef toRange As Range)
toRange.Value2 = fromRange.Value2
End SubPublic Function getWorkBook(ByVal wbName As String) As Workbook
Dim wb As Workbook
For Each wb In Application.Workbooks
If wb.Name = wbName Then
Set getWorkBook = wb
Exit Function
End If
Next
End FunctionContext
StackExchange Code Review Q#96083, answer score: 3
Revisions (0)
No revisions yet.