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