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

Copying data entry values in to a separate WorkFile

Submitted by: @import:stackexchange-codereview··
0
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.

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 Sub


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

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 .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 code

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 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 worksheets

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 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 rng to 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 Sub


The 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 UpdateTable
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
Sub CopyData(ByRef fromRange As Range, ByRef toRange As Range)
    toRange.Value2 = fromRange.Value2
End Sub
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 Function
        End If
    Next
End Function

Context

StackExchange Code Review Q#96083, answer score: 3

Revisions (0)

No revisions yet.