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