Array or Array List Parsing date/time from Access in Excel

[Felix1980]

I have been working on a project for the boss for a month now and I have come to a wall. We get data from Kronos to let us know all the swipe data for all employees. I have to take that data and get info by the minute. For example, wages for "x" department per minute, which the boss wants to use to get cost per item per minute. So far I have pulled the data from Kronos, cleaned it up and put it into an Access database as there will eventually be more lines than Excel can handle. In Access I've done some queries for calculations. I then linked the Access Table into an Excel spreadsheet so that I can create code to spread all the info out across minutes of the year. The sheet I created for this has every minute of last year down the A column, coming to almost 53,000 rows. I then created some code to add the employee numbers across the columns on row 1, which currently is 582 columns but will expand with new employees.

.

I'm sure there is a better way to do this and would be open to suggestions, please remember that I am fairly new and only self taught. Below is the code I have created so far to populate this sheet :

Option Explicit

Sub GrabMe()
'Grab time ranges and break them down to the minute

Dim wb As Workbook
Dim Sourcews As Worksheet
Dim Destws As Worksheet
Dim Timecoll As Object
Dim DEmpcoll As Object
Dim SourceLRow As Long
Dim DestLRow As Long
Dim DestLColumn As Long
Dim DDateRng As Range
Dim DEmpRng As Range
Dim SEmpRng As Range
Dim tchange As String
Dim SEmpcoll As Object
Dim SEmpReturn As Variant
Dim DestReturn As Integer
Dim t As Range
Dim tReturn As Variant
Dim eReturn As Variant
Dim btime As Variant
Dim ctime As Variant
Dim dtime As Variant
Dim Timearr As Variant
Dim DestLColumnLetter As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Set wb = Workbooks("TimeDetail.xlsx")
Set Sourcews = wb.Sheets("kronos_shift")
Set Destws = wb.Sheets("DepartmentPerMin")
Set Timecoll = CreateObject("System.Collections.ArrayList")
Set DEmpcoll = CreateObject("System.Collections.Arraylist")
Set SEmpcoll = CreateObject("System.Collections.Arraylist")
SourceLRow = Sourcews.Cells(Sourcews.Rows.Count, "A").End(xlUp).Row
DestLRow = Destws.Cells(Destws.Rows.Count, "A").End(xlUp).Row
DestLColumn = Destws.Cells(1, Columns.Count).End(xlToLeft).Column

DestLColumnLetter = Split(Cells(1, DestLColumn).Address, "$")(1)

'This collection is for all the date/times in the destination sheet
For Each DDateRng In Destws.Range("A2:A" & DestLRow)
    Timecoll.Add CStr(Destws.Cells(DDateRng.Row, 1).Value)
Next DDateRng

'This collection is for all the employeeIDs across the top of the destination sheet
For Each DEmpRng In Destws.Range("B1:" & DestLColumnLetter & "1")
'For Each DEmpRng In Destws.Range(Destws.Cells(1, 2), Destws.Cells(1, DestLColumn))
    DEmpcoll.Add CDbl(Destws.Cells(1, DEmpRng.Column).Value)
    Debug.Print DEmpRng
Next DEmpRng


Dim i As Long
For i = 0 To DEmpcoll.Count - 1
    Debug.Print DEmpcoll.Item(i)
    Debug.Print DEmpcoll.Indexof(DEmpcoll.Item(i), 0)
Next i

'This collection is for all the employeeIDs in the source sheet
For Each SEmpRng In Sourcews.Range("B2:B" & SourceLRow)
    SEmpcoll.Add Sourcews.Cells(SEmpRng.Row, 2).Value
Next SEmpRng



'Add any missing employee#s to the destination sheet
For Each SEmpReturn In SEmpcoll
    DestReturn = DEmpcoll.Indexof(SEmpReturn, 0)
        If DestReturn = -1 Then
            Destws.Cells(1, DestLColumn + 1).Value = SEmpReturn
            DestLColumn = Destws.Cells(1, Columns.Count).End(xlToLeft).Column
            DEmpcoll.Add SEmpReturn
            DestReturn = DEmpcoll.Indexof(SEmpReturn, 0) '+ 2
        Else
            'DestReturn = DestReturn + 2
          '  Destws.Cells(1,DestReturn).value = Sourcews.Cells(1,SEmpcoll.
        End If
Next SEmpReturn

'Add the times
For Each t In Sourcews.Range("F2:F" & SourceLRow)

    tchange = CStr(t.Value)
    tReturn = Timecoll.Indexof(tchange, 0) + 2
    eReturn = SEmpcoll.Indexof(CDbl(t.Offset(0, -4).Value), 0) + 2
    dtime = Timecoll.Indexof(CStr(t.Offset(0, 1).Value), 0) + 2
    
    If tReturn = -1 Then
        MsgBox "Is it a new year?  This date / time doesn't appear to be in the list.  " & tchange
        Exit Sub
    End If
        
    If t.Offset(0, 18) <> "" Then
        btime = Timecoll.Indexof(CStr(t.Offset(0, 18)), 0) + 2
        ctime = Timecoll.Indexof(CStr(t.Offset(0, 19)), 0) + 2
        Destws.Range(Cells(tReturn, eReturn), Cells(btime, eReturn)).Value = t.Offset(0, 4).Value
        Destws.Range(Cells(ctime, eReturn), Cells(dtime, eReturn)).Value = t.Offset(0, 4).Value
    Else
        Destws.Range(Cells(tReturn, eReturn), Cells(dtime, eReturn)).Value = t.Offset(0, 4).Value
       ' Destws.Cells(tReturn, eReturn).Value = t.Offset(0, 4).Value
    End If
    
Next t
   
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
    
End Sub

I am having some issues with the code. The employee#'s arraylist is acting strangely. It seems to say every employee number is located at "0". I'm wondering if this is because it's a horizontal list since the time list seems to work fine. I'm not sure how to fix it though.
I was going to convert this to an array (copy the whole sheet into one array and manipulate from there to make it faster) but it gives me an error when I try to load it and I'm wondering if the size (A1:VJ527041) is too large for an array.

The source data that is linked from Access looks like the following :

I could really use some suggestions, even if it's to throw this away and go in a different direction, though I hope that isn't the anwer!