Tabulate schedule/calendar for database import

Question

My company uses an Excel workbook to schedule our manufacturing jobs. I'm attempting to log job positions on the schedule and import them into Access on a semi-regular basis (twice a month?). This will enable analytics of lead times currently impossible with our current system.

The schedule is made up of a 19-row-header containing machine names, and boxes to track current runs for the current week. Below the header is an array of 5R x 6C cell blocks each assigned to a single order. The top-left cell contains the job number and is used as the ID for the vlookups in the other cells of the block to populate order information.

The run quantity is cell(1R,5C) of each block and is entered manually, so I must capture it.

There are two columns to the left of the job blocks that list the week dates in a consistent "MM/DD/YYYY - MM/DD/YYYY" format spanning Monday - Friday only. There are 6 job blocks (5 x 6 cells) for each week per column. I want to export the date of Friday, so I need the right-side of the string at the hyphen + 1.

Each block-column represents a single machine in the plant. There are 16 such columns for our 16 machines.

All worksheets containing a monthly schedule are named [MonthName][YYYY], but there are other worksheets in the workbook that I want to ignore.

Cell Blocks diagram. 5R x 6C, underscores denote horizontal cell merges and bars denote vertical cell merges though not very well. (R1-4, C5) and (R1-4, C6) are vertically merged.

 1   2   3   4   5   6
[_] [_____] [_] [ ] [ ]
[_____________] | | | |
[_____________] | | | |
[_____________] |_| |_|
[ ] [ ] [_____] [ ] [ ]

Job is (R1,C1), Date is in column A of worksheet, quantity in (R1-4,C5), machine in row 19.

All in all, my code does an okay job transposing the Job number, Date, machine, and run quantity. However, it yields ~1500 rows and takes about 15 minutes to run.

I'd very much like some help in improving the performance of this procedure. I have included my code comments in the hopes that it will be clear what is going on with the background above. If my description of the layout is insufficient, I can post a picture, but I hate to resort to that.

There is no process built yet to actually import into access, this procedure is currently building the table only.

I'm self-taught and the sole developer at my company and I have never had a code review. I'm just a Mort attempting to become an Elvis. Please show me the errors of my ways (line 3, goto).

Here is my procedure:

Option Explicit
Sub ExportToAccess()

On Error GoTo PROC_ERR

Dim ws As Worksheet
Dim yearNum As Integer
Dim Cyear As String
Dim Nyear As String
Dim Worksheet As String
Dim FinalRow As Integer
Dim x As Integer
Dim y As Integer
Dim NextRow As Integer
Dim WeekEndDate As String

'Pause screen updates so screen doesn't flash
Application.ScreenUpdating = False

'Ask for year to export
yearNum = InputBox("Please specify the year you intend to export.")

'Load current year as string
Cyear = CStr(yearNum)
'Load next year as string, export all future months despite year entered
Nyear = CStr(yearNum + 1)

'Cycle through each worksheet of the workbook
For Each ws In Worksheets
    'Check worksheet name ending for year match
    If Right(ws.Name, 4) = Cyear Or Right(ws.Name, 4) = Nyear Then
        'Match found, load worksheet name into variable "Worksheet"
        Worksheet = ws.Name
        'Last row of each month
        FinalRow = 165
        'Set y to column index. Start at column "C" and go through to "DC"
        For y = 3 To 104 Step 6
            'Set x to row index. Start at row 20 and go to FinalRow.
            For x = 20 To FinalRow Step 5
                'Do not process if cell is null
                If IsNull(Cells(x, y).Value) = False Then
                    'Do not process if cell is non-numeric
                    If IsNumeric(Cells(x, y).Value) Then
                        'JOB NUMBER
                        'Find next row on output worksheet
                        NextRow = Sheets("Output").Cells(Rows.Count, 1).End(xlUp).Row + 1
                        'Copy Job number from cell on schedule to output sheet
                        Sheets("Output").Cells(NextRow, 1).Value = Sheets(Worksheet).Cells(x, y).Value

                        'RUN DATE
                        'Set variable to schedule date range value; Absolute column A. Column A is merged vertically
                        WeekEndDate = Sheets(Worksheet).Cells(x, 1).MergeArea.Cells(1, 1).Value
                        'Find the week end date, strip the range from the string
                        WeekEndDate = Mid(WeekEndDate, InStr(1, WeekEndDate, "-") + 2, (Len(WeekEndDate) - InStr(1, WeekEndDate, "-")))
                        'Place in second column of new row set above
                        Sheets("Output").Cells(NextRow, 2) = WeekEndDate

                        'MACHINE
                        'Copy machine value from row 19 of current column
                        Sheets("Output").Cells(NextRow, 3) = Sheets(Worksheet).Cells(19, y)

                        'RUN QUANTITY
                        'Copy run quantity from cell block. Offset column + 4
                        Sheets("Output").Cells(NextRow, 4) = Sheets(Worksheet).Cells(x, y + 4)

                        'Indexing for debugging
                        'Sheets("Output").Cells(NextRow, 5) = x
                        'Sheets("Output").Cells(NextRow, 6) = y
                    End If
                End If
            Next x
        Next y
    End If
Next ws

Application.ScreenUpdating = True

MsgBox "All done."

Exit Sub

PROC_ERR:
MsgBox "Error: " & Err.Number & "; " & Err.Description
Exit Sub

End Sub

Answer 1

Overall not bad. Most of the issues are minor and stylistic, so don't let my brain dump below overwhelm...

---

1.) Comments - Limit your comments to code that isn't obvious as to what it does. The goal should be to explain the reason for code, not just to describe how it functions. For example...

'Ask for year to export
yearNum = InputBox("Please specify the year you intend to export.")

...and..

'Cycle through each worksheet of the workbook
For Each ws In Worksheets

...are commenting on things that are completely obvious from reading the line below them. A good rule of thumb is "would I trust the person who needs this comment to alter this code"? If the answer is no, leave it out. Otherwise it just adds noise.

---

2.) Duplicate dereferences - Capture references to objects that you repeatedly reference. I see 5 calls to Sheets("Output"), and the worksheet that it returns is never going to change. Get a reference before you start the loop and use it instead:

Dim target As Worksheet
Set target = Worksheets("Output")
'...
target.Cells(x, 1)...

---

3.) Deterministic lookups - Along the same lines as #2, use the references that you do have. You get the name of each worksheet here:

Worksheet = ws.Name

Then the only place it's used is to index into the Sheets collection like this...

Sheets(Worksheet)

...which always returns ... wait for it ... ws. Just use ws.

---

4.) You have a bug. This line of code...

If IsNumeric(Cells(x, y).Value) Then

...will always test the value of the active worksheet because you're using the global Cells collection. You need to fully qualify all of your references to Cells with a worksheet:

If IsNumeric(ws.Cells(x, y).Value) Then

I'd also qualify this reference to Rows, although Rows.Count will return the same value for any given worksheet. This should be habitual:

NextRow = Sheets("Output").Cells(Rows.Count, 1).End(xlUp).Row + 1

---

5.) Use constants - You have a bunch of magic number columns that you were compelled to comment, like this one:

'MACHINE
'Copy machine value from row 19 of current column
Sheets("Output").Cells(NextRow, 3) = Sheets(Worksheet).Cells(19, y)

You can make your code more readable and maintainable you defining and using constants instead of numbers:

'Module level
Private Const MACHINE_COL As Long = 3
Private Const SOURCE_MACHINE_COL As Long = 19
'...
target.Cells(NextRow, MACHINE_COL) = ws.Cells(SOURCE_MACHINE_COL, y)

Also, FinalRow is always 165 - there's no reason for it to be a variable.

---

6.) Use String returning functions - Most of the string utility functions have a version that returns a Variant and a version that returns a String (which ends with $). Unless you are storing the result in a Variant, you should use the String version to avoid implicitly casting the return value. There's a full list here.

---

7.) Use With blocks - Repeated dereferencing of objects to access members isn't free. Find sections of your code where you use the same object repeatedly, and then wrap it in a With ThatObject block. In this case, Sheets("Output") would be a good candidate.

---

8.) Get rid of superfluous tests - Unless I'm mistaken (and hopefully someone will correct me in the comments if I am), there isn't any way for Excel to return Null as the .Value of a cell:

Sub Nope()
    Sheet1.Cells(1, 1).Value = Null
    Debug.Print IsNull(Sheet1.Cells(1, 1).Value) 'Prints False
End Sub

You can remove the If IsNull(Cells(x, y).Value) = False Then test.

---

9.) Remove unneeded variables - Cyear will always be the same value as yearNum, although it does need to be validated and trimmed. See below.

---

10.) Don't trust user input - You'll get subtle errors with this code...

'Ask for year to export
yearNum = InputBox("Please specify the year you intend to export.")

'Load current year as string
Cyear = CStr(yearNum)
'Load next year as string, export all future months despite year entered
Nyear = CStr(yearNum + 1)

...if the user enters some non-numeric value like "this year". Validate user input to make sure you're getting a number. There are good examples of this over on SO.

---

11.) Useless lines - There's not really much point to the Exit Sub statement here...

PROC_ERR:
MsgBox "Error: " & Err.Number & "; " & Err.Description
Exit Sub

End Sub

...because... wait for it ... it's already the last statement in the Sub. I'd remove it.

---

Conclusion

Taking all of the above, the main loop should look more like this...

With Worksheets("Output")
    For Each ws In Worksheets
        If Right$(ws.Name, 4) = yearNum Or Right$(ws.Name, 4) = Nyear Then
            For y = 3 To 104 Step 6
                For x = 20 To 165 Step 5
                    If IsNumeric(ws.Cells(x, y).Value) Then
                        NextRow = .Cells(.Rows.Count, JOB_NUMBER_COL).End(xlUp).Row + 1
                        Sheets("Output").Cells(NextRow, JOB_NUMBER_COL).Value = Sheets(Worksheet).Cells(x, y).Value
                        'RUN DATE
                        'Set variable to schedule date range value; Absolute column A. Column A is merged vertically
                        WeekEndDate = ws.Cells(x, 1).MergeArea.Cells(1, 1).Value
                        'Find the week end date, strip the range from the string
                        WeekEndDate = Mid$(WeekEndDate, InStr(1, WeekEndDate, "-") + 2, _
                                           Len(WeekEndDate) - InStr(1, WeekEndDate, "-"))
                        .Cells(NextRow, RUN_DATE_COL) = WeekEndDate
                        .Cells(NextRow, MACHINE_COL) = ws.Cells(SOURCE_MACHINE_COL, y)
                        .Cells(NextRow, QUALITY_COL) = ws.Cells(x, y + 4)
                    End If
                Next x
            Next y
        End If
    Next ws
End With

...assuming the following constants:

Private Const JOB_NUMBER_COL As Long = 1
Private Const RUN_DATE_COL As Long = 2
Private Const MACHINE_COL As Long = 3
Private Const QUALITY_COL As Long = 4
Private Const SOURCE_MACHINE_COL As Long = 19

You can probably get a decent performance gain by switching to array processing instead of direct worksheet access, but it would be hard to recommend how to do that without seeing the actual workbook given the presence of merged cells.