The original solution
The original iteration I came up with to import the data is my standard approach of walking through the cells and pulling in each data point. As I covered off in the previous post, I also had to pull together a few pieces of meta data to describe each data point and then write the row of data to the data provider workbook. Here is the code snippet that does this
With m_SummarySheet
'Initialise the variables
m_lngDRow = .UsedRange.Rows.Count 'get the last row of the destination worksheet for appending
If m_lngDRow = 3 Then m_lngDRow = m_lngDRow - 1 'adjust it if the table is empty, which throws the count function out
m_lngNoRecordCount = m_lngDRow 'set the variable used to check if no data was found
'We will use the same row repeatedly for capturing the hour as it aligns with all data
intHourRow = 12
'This is the category row for the first set of data
intCatRow = 10
'now step through each row of data in the worksheet
For m_lngSRow = 13 To 537 Step 1
'Because the data is in blocks that are separated by inconsistent gaps, we set the start points based on simple logic
If m_lngSRow = 44 Then
m_lngSRow = 48 'for each data block we set the start row for the data
intCatRow = 45 'and the category row
End If
If m_lngSRow = 79 Then
m_lngSRow = 83
intCatRow = 80
End If
If m_lngSRow = 114 Then
m_lngSRow = 118
intCatRow = 115
End If
If m_lngSRow = 149 Then
m_lngSRow = 153
intCatRow = 150
End If
If m_lngSRow = 184 Then
m_lngSRow = 190
intCatRow = 187
End If
If m_lngSRow = 221 Then
m_lngSRow = 225
intCatRow = 222
End If
If m_lngSRow = 256 Then
m_lngSRow = 260
intCatRow = 257
End If
If m_lngSRow = 291 Then
m_lngSRow = 295
intCatRow = 292
End If
If m_lngSRow = 326 Then
m_lngSRow = 330
intCatRow = 327
End If
If m_lngSRow = 361 Then
m_lngSRow = 367
intCatRow = 364
End If
If m_lngSRow = 398 Then
m_lngSRow = 402
intCatRow = 399
End If
If m_lngSRow = 433 Then
m_lngSRow = 437
intCatRow = 434
End If
If m_lngSRow = 468 Then
m_lngSRow = 472
intCatRow = 469
End If
If m_lngSRow = 503 Then
m_lngSRow = 507
intCatRow = 504
End If
For m_intSCol = 3 To 26 Step 1
If m_SourceSheet.Cells(m_lngSRow, m_intSCol).Value <> "" Then
.Cells(m_lngDRow, 1).Value = m_strCompany ' Contract holder
.Cells(m_lngDRow, 2).Value = m_strArea 'Contract area
.Cells(m_lngDRow, 3).Value = m_dteStartDate 'FromDate of the workbook period
.Cells(m_lngDRow, 4).Value = m_SourceSheet.Cells(intCatRow, 2).Value 'Category
.Cells(m_lngDRow, 5).Value = m_SourceSheet.Cells(m_lngSRow, 2).Value 'Date
.Cells(m_lngDRow, 6).Value = "'" & m_SourceSheet.Cells(intHourRow, m_intSCol).Value 'Hour written as a string to keep the leading 0
'check if data is missing
If m_SourceSheet.Cells(m_lngSRow, m_intSCol).Value = "" Then g_boolIncomplete = True
.Cells(m_lngDRow, 7).Value = m_SourceSheet.Cells(m_lngSRow, m_intSCol).Value 'Value
'Step down a row in the destination worksheet
m_lngDRow = m_lngDRow + 1
End If
Next m_intSCol
Next m_lngSRow
End With
So lets break this down, The approach uses a nested loop model with one loop tracking the rows of data and the other stepping through the columns. Note that because I know the source worksheet is always going to have 537 lines of data, I use the For m_lngSRow = 13 To 537 Step 1 statement to scan through line by line. The m_lngSRow is the variable used to step through the rows of data in the source sheet, and as such, I need to make sure it only scans the rows with the relevant data. So when it reaches a break point between the end on one data set and the next data set, I use a bunch of simple IF statement to reset the variable to the start of the next data block and at the same time, I also ensure the intCatRow variable used to track the right Category for the data is also set correctly.
The second loop is taken care of with the For m_intSCol = 3 To 26 Step 1 statement, again I know there are always going to be 26 columns of data. So with these two loops I have a model that starts at the first row, scans through all the cells on that row that hold data, steps to the next row, and repeats the scan through columns. But what do I want to do when I get to each row and cell?
The first step is a test for a date in the first column with m_SourceSheet.Cells(m_lngSRow, m_intSCol).Value <> “”. The logic here is that each block of data is 31 rows tall because there is a row for each day of the month. But some months have less than 31 days, so this IF test will skip any further action for the row and step on to the next row.
If there is a value, then for each cell, or data point, I write a row in the destination sheet. This is achieved by using the destination cell equals something approach, seven columns of data and seven write statements:
.Cells(m_lngDRow, 1).Value = m_strCompany ' Contract holder .Cells(m_lngDRow, 2).Value = m_strArea 'Contract area .Cells(m_lngDRow, 3).Value = m_dteStartDate 'FromDate of the workbook period .Cells(m_lngDRow, 4).Value = m_SourceSheet.Cells(intCatRow, 2).Value 'Category .Cells(m_lngDRow, 5).Value = m_SourceSheet.Cells(m_lngSRow, 2).Value 'Date .Cells(m_lngDRow, 6).Value = "'" & m_SourceSheet.Cells(intHourRow, m_intSCol).Value 'Hour written as a string to keep the leading 0 .Cells(m_lngDRow, 7).Value = m_SourceSheet.Cells(m_lngSRow, m_intSCol).Value 'Value 'Step down a row in the destination worksheet m_lngDRow = m_lngDRow + 1
Whats so wrong with this approach
So what is the answer

Dim Arr() As Variant
Arr = Range("A1:B10")
Dim R As Long
Dim C As Long
For R = 1 To UBound(Arr, 1) ' First array dimension is rows.
For C = 1 To UBound(Arr, 2) ' Second array dimension is columns.
Debug.Print Arr(R, C)
Next C
Next R
So when you load a range into an array with the wonderfully simple code Arr = Range(“A1:B10”), a two dimensional array of data is created. In the case of the workbooks I was importing, this means I now only needed to switch the focus to the source workbook 15 times per workbook for each block of data instead of 10,000 times for each cell of data. Clearly this was going to be a benefit.
Next we use the same nested loop model discussed earlier to walk through the data points in the same way, For R = 1 to UBound(Arr,1) is the equivalent of my previous For m_lngSRow = 13 To 537 Step 1 statement, whereas the For C = 1 To Ubound(Arr, 2) equates to the For m_intSCol = 3 To 26 Step 1 statement.
The solution in action
With m_SummarySheet
m_lngDRow = .UsedRange.Rows.Count
If m_lngDRow = 3 Then m_lngDRow = m_lngDRow - 1
m_lngNoRecordCount = m_lngDRow
intLoopCount = 1
For intLoopCount = 1 To 15 Step 1
Select Case intLoopCount
Case 1
intCatRow = 10
'load a .Range to an array
Arr = m_SourceSheet.Range("B13:Z43")
Case 2
intCatRow = 45
'load a .Range to an array
Arr = m_SourceSheet.Range("B48:Z78")
Case 3
intCatRow = 80
'load a .Range to an array
Arr = m_SourceSheet.Range("B83:Z113")
Case 4
intCatRow = 115
'load a .Range to an array
Arr = m_SourceSheet.Range("B118:Z148")
Case 5
intCatRow = 150
'load a .Range to an array
Arr = m_SourceSheet.Range("B153:Z183")
Case 6
intCatRow = 187
'load a .Range to an array
Arr = m_SourceSheet.Range("B190:Z220")
Case 7
intCatRow = 222
'load a .Range to an array
Arr = m_SourceSheet.Range("B225:Z255")
Case 8
intCatRow = 257
'load a .Range to an array
Arr = m_SourceSheet.Range("B260:Z290")
Case 9
intCatRow = 292
'load a .Range to an array
Arr = m_SourceSheet.Range("B295:Z325")
Case 10
m_lngSRow = 330
intCatRow = 327
'load a .Range to an array
Arr = m_SourceSheet.Range("B330:Z360")
Case 11
m_lngSRow = 367
intCatRow = 364
'load a .Range to an array
Arr = m_SourceSheet.Range("B367:Z397")
Case 12
intCatRow = 399
'load a .Range to an array
Arr = m_SourceSheet.Range("B402:Z432")
Case 13
intCatRow = 434
'load a .Range to an array
Arr = m_SourceSheet.Range("B437:Z467")
Case 14
intCatRow = 469
'load a .Range to an array
Arr = m_SourceSheet.Range("B472:Z502")
Case 15
intCatRow = 504
'load a .Range to an array
Arr = m_SourceSheet.Range("B507:Z537")
End Select
strCat = m_SourceSheet.Cells(intCatRow, 2).Value
intLoopCount = intLoopCount + 1 'incrment the loop count
For R = 1 To UBound(Arr, 1) ' First array dimension is rows.
C = 1
If Arr(R, C) <> "" Then
intHour = 0 'reset the hour to 0
dteDate = Arr(R, C) 'Date
For C = 2 To UBound(Arr, 2) ' Second array dimension is columns.
.Cells(m_lngDRow, 1).Value = m_strCompany ' Service contract holder
.Cells(m_lngDRow, 2).Value = m_strArea 'Service contract area
.Cells(m_lngDRow, 3).Value = m_dteStartDate 'FromDate of the workbook period
.Cells(m_lngDRow, 4).Value = strCat 'Category
.Cells(m_lngDRow, 5).Value = dteDate 'date
.Cells(m_lngDRow, 6).Value = intHour 'Hour written as a string to keep the leading 0
'check if data is missing
If Arr(R, C) = "" Then g_boolIncomplete = True
.Cells(m_lngDRow, 7).Value = Arr(R, C) 'Value
m_lngDRow = m_lngDRow + 1
intHour = intHour + 1
Next C
End If
Next R
'clear the array
Erase Arr
Next intLoopCount
End With
The code starts out the same with establishing the variables for writing to the destination sheet, it takes a different turn for how I approached the different data blocks. This time around I opted for a three level nested loop. the first level used a variable called intLoopCount that counted the number of times I had run the import process, which is once per data block. I know there are 15 groups of data in a workbook, so I count from 1 to 15. I then used a Select Case statement to use the intLoopCount to know which bundle of data I was importing. Similar to the previous model, I identify the category location but instead of setting the start to the range, I load the range into the array and that is the last time I look at the import workbook until I have written all the values to the destination sheet.
Immediately after the Select Case, I grab the Category value into a variable, strCat = m_SourceSheet.Cells(intCatRow, 2).Value as this information applies to all values in the array, then I increment the loop count with intLoopCount = intLoopCount + 1, and point the first array dimension at the first “row” of the array R = 1.
I then start stepping through the first dimension of the array with the code directly from the Pearson site, For R = 1 To UBound(Arr, 1) , the first array dimension is rows. The second, “columns”, dimension is then initialised with C = 1.
The If Arr(R, C) <> “” statement performs the same check as discussed earlier to detect if there is a date in the first “column” of the array and as such detect if we had come to the end of the month.
This time around I didn’t extract the hour from the import sheet, instead opting to generate the value by counting from 0 to 23 using the intHour variable. In the previous code I converted the value into a string to retain the leading zero for single digit values, this time I simply formatted the destination column with a custom “00” format that forces the leading zero.
As the date is applicable to all values in the row of data, I then capture the date value into a variable using dteDate = Arr(R, C) before I start stepping through the column dimension with:
For C = 2 To UBound(Arr, 2) ' Second array dimension is columns.
.Cells(m_lngDRow, 1).Value = m_strCompany ' Service contract holder
.Cells(m_lngDRow, 2).Value = m_strArea 'Service contract area
.Cells(m_lngDRow, 3).Value = m_dteStartDate 'FromDate of the workbook period
.Cells(m_lngDRow, 4).Value = strCat 'Category
.Cells(m_lngDRow, 5).Value = dteDate 'date
.Cells(m_lngDRow, 6).Value = intHour 'Hour written as a string to keep the leading 0
'check if data is missing
If Arr(R, C) = "" Then g_boolIncomplete = True
.Cells(m_lngDRow, 7).Value = Arr(R, C) 'Value
m_lngDRow = m_lngDRow + 1
intHour = intHour + 1
Next C
Take note of the similarity to the previous code, yet the significant difference in the absence to any reference to the import workbook. The result is an import time cut from more than 2 hours down to just over 15 minutes. It is now feasible for the users to import the data during their normal working day without impacting their general productivity too significantly.
For those of you who have been following my blog on the advanced excel contract management solution, don’t give up, I promise the next edition is on the way. The next instalment will cover how to separate the data from the data entry and uses a similar technique that discussed earlier in this blog.
As always, if you have any questions, leave a comment below, visit the PME4U forums or contact us directly through the Contact PME4U. Thanks for reading and best of luck with your coding.