Subscript out of range

S

Shamusvw

New Member
Joined
Feb 1, 2017
Messages
28
Office Version
  1. 365
Platform
  1. Windows
Hello
I know the error message about is a common one, however I can't trace why it is giving me this error.
I have a Sub Auto_Open() in a module1 where I call a procedure under one of my sheets.
This runs fine when I open the spreadsheet.
In my procedure itself that gets called, I also have the following call, so that every twenty minutes the same procedure gets called again:

Code: 
Application.OnTime Now + TimeValue("00:20:00"), "Sheet2.GetUtilisation"

This all works fine, and it runs multiple times without any error.
If however, I open up a 2nd Excel file, and this new file has focus when the other file's procedure runs, it then throws the error "Subscript out of range"
If I then swop to the first file again that runs this procedure, even if the 2nd file is still open (but doesn't have the focus), then this error doesn't occur.

Can anyone point me to what might be the issue?
I'm thinking that the command might be getting confused between which file contains the procedure to keep running.
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
You'll need to post the code for Sheet2.GetUtilisation please.
 
Upvote 0
In my code where you see me updating a cell (N100), it is part of my debugging trying to figure out where it is failing.
Subsequent to this, it found it was caused where I moved focus to a different spreadsheet/Excel file that was causing the error. so you can ignore the cell write.

This is module1 code...

Code: 
Sub Auto_Open()
 Application.DisplayFullScreen = True
 Worksheets("Casting Data").Range("N100").Value = "0"
 Worksheets("Casting Data").GetUtilisation
 'Sheet2.GetUtilisation
End Sub
Private Sub Workbook_Close()
 Application.DisplayFullScreen = False
End Sub

This is Sheet2.GetUtilisation code (The sheet itself is called "Casting Data")
Code: 
Sub GetUtilisation()
  'For querying of databases, need to first do following...
  'Tools > References > Check the checkbox in front of "Microsoft ActiveX Data Objects 2.5 Library" (or the latest available)
  
  Worksheets("Casting Data").Range("N100").Value = "0"
  On Error GoTo ThereWasAnError
  
  'query the MySQL database and extract all cycle cadences
  'MySQL connection
  Dim conn As New ADODB.Connection
  Set conn = New ADODB.Connection
  Dim recset As New ADODB.Recordset
  Set recset = New ADODB.Recordset
  conn.Open "Provider=MSDASQL; Driver={MySQL ODBC 5.3 ANSI Driver};Server=192.168.2.10;Port=3306;Database=xxx;User=xxx;Password=xxx;Option=3"
  
  'extract all cadence values to then pull out rows that are greater than a set value
  'reason why not filtering first is because a cycle just before shift end < setValue might need to altered
  Dim tempData, cadenceData As Variant
  Dim query As String
  Dim i As Integer
  
  Dim util(1 To 31) As Variant 'array to hold non-utilisations for each 31 days
  Dim utilDates() As Variant 'array to hold dates of util array
  
  'loop through all data stored in variant array
  Const utilValue As Integer = 180 'the value above which time is now taken as non-utilisation in seconds
  Dim dt, dm As Double
  Dim ds As Long
  Dim j As Integer
  Dim k As Long
  
  For Position = 1 To 14 'all the positions of the machines
    Worksheets("Casting Data").Range("N100").Value = "1-" + CStr(Position)
    'Retrieve only current month's data. 6am is the first shift on the first day, 6am 1st of new month ends the current month
    'any time from 6am to very first cycle > value is non-productive
    'any time from very last cycle > value is non-productive
    'shift timestamp 6 hours earlier to remove shift start offset of 6am
    query = "SELECT DATE_ADD(cycle_timestamp, INTERVAL -6 HOUR) AS cycle_timestamp, cadence FROM daq_i.cycle_cadence_pos" + CStr(Position) + " " & _
            "WHERE YEAR(DATE_ADD(cycle_timestamp, INTERVAL -6 HOUR)) = YEAR(now()) " & _
            "AND MONTH(DATE_ADD(cycle_timestamp, INTERVAL -6 HOUR)) = MONTH(now())"
    conn.CursorLocation = adUseClient
    recset.Open query, conn
  
    Worksheets("Casting Data").Range("N100").Value = "2-" + CStr(Position)
    '0) insert the current timestamp as the very last row of the retrieved data, then include in processing
    '1) add shift changes if needed before very first row timestamp
    '2) adjust very first row of data to reflect cadence to last inserted row of shifts
    '3) iterate through all rows of data, if cadence < value, set to zero
    '   reason for doing this before splitting cadence over shifts, is because after split each part might be < value, and don't want to lose this
    '4) insert an extra row at every shift change (if not existing) that splits the stoppage across the shift change into the last cycle of previous shift and shift change
    '   then update the first cycle's cadence to reflect the split
    rw = recset.RecordCount
    If rw <> 0 Then
      Worksheets("Casting Data").Range("N100").Value = "3-" + CStr(Position)
      cadenceData = recset.GetRows 'place query data into array
      
      '0) insert the current timestamp as the very last row of the retrieved data, then include in processing
      ReDim Preserve cadenceData(1, UBound(cadenceData, 2) + 1)
      ub = UBound(cadenceData, 2)
      cadenceData(0, ub) = Now - 6 / 24 'remember everything shifted backwards by 6 hours
      sf = cadenceData(0, ub) - cadenceData(0, ub - 1)
      cadenceData(1, ub) = Round((cadenceData(0, ub) - cadenceData(0, ub - 1)) * 86400, 0)
      
      '1) add shift changes if needed before very first row timestamp
      dt = DateSerial(Year(Now), Month(Now), 1) 'the 1st of current month, 12am
      dm = cadenceData(0, 0)  'get very first timestamp recorded
      ReDim tempData(1, 0)
      i = 0
      While dt < dm
        tempData(0, i) = dt
        If i = 0 Then
         tempData(1, i) = 0 ' since this measures the cadence to previous cycle. Because very 1st cycle, doesn't matter what happened before
        Else
         tempData(1, i) = 28800 '=hours
        End If
        dt = dt + 1 / 3 '8hrs = 1/3 day
        i = i + 1
        ReDim Preserve tempData(1, UBound(tempData, 2) + 1)
      Wend
      
      Worksheets("Casting Data").Range("N100").Value = "4-" + CStr(Position)
      '2) adjust very first row of data to reflect cadence to last inserted row of shifts
      'dt contains the next shift timestamp that would have been inserted so decrease by 8 hours if i > 0
      If i > 0 Then
        dt = dt - 1 / 3
      End If
      cadenceData(1, 0) = Round((cadenceData(0, 0) - dt) * 86400, 0)
      
      '3) iterate through all rows of data, if cadence < value, set to zero
      '   reason for doing this before splitting cadence over shifts, is because after split each part might be < value, and don't want to lose this
      For i = LBound(cadenceData, 2) To UBound(cadenceData, 2)
        If cadenceData(1, i) < utilValue Then
          cadenceData(1, i) = 0
        End If
      Next i
      
      Worksheets("Casting Data").Range("N100").Value = "5-" + CStr(Position)
      '4) insert an extra row at every shift change (if not existing) that splits the stoppage across the shift change into the last cycle of previous shift and shift change
      '   then update the first cycle's cadence to reflect the split
      j = UBound(tempData, 2)  'first index where rows will be moved into
      dt = dt + 1 / 3 'look for the next shift split
      flag = 0
      For i = LBound(cadenceData, 2) To UBound(cadenceData, 2)
        If cadenceData(0, i) < dt Then 'dt = the shift split
          tempData(0, j) = cadenceData(0, i)
          tempData(1, j) = cadenceData(1, i)
          ReDim Preserve tempData(1, UBound(tempData, 2) + 1)
          j = j + 1
        ElseIf cadenceData(0, i) > dt Then 'if cadenceData(0, i) "=" td, then doesn't need a shift split as this already is one
          While cadenceData(0, i) > dt 'the might be more than 1 shift splits missing
            flag = 1
            tempData(0, j) = dt
            If cadenceData(1, i) > 0 Then 'all cadences already determined previously if > utilValue - see 3)
              tempData(1, j) = Round((tempData(0, j) - tempData(0, j - 1)) * 86400, 0)
            Else
              tempData(1, j) = 0
            End If
            dt = dt + 1 / 3 'look for the next shift split
            ReDim Preserve tempData(1, UBound(tempData, 2) + 1)
            j = j + 1
          Wend
        End If
        If flag = 1 Then 'test if added in shift splits, because then still needing to add in the row that was being compared against
          flag = 0
          tempData(0, j) = cadenceData(0, i)
          If cadenceData(1, i) > 0 Then 'all cadences already determined previously if > utilValue - see 3)
            tempData(1, j) = Round((cadenceData(0, i) - (dt - 1 / 3)) * 86400, 0)
          Else
            tempData(1, j) = 0
          End If
          ReDim Preserve tempData(1, UBound(tempData, 2) + 1)
          j = j + 1
        End If
      Next i
      
      Worksheets("Casting Data").Range("N100").Value = "6-" + CStr(Position)
      'calculate utilisation by summing up totals for each shift
      'for the last shift that has time allocated, max time is how long has passed in shift already
      'get how many days in current month, x 3 = no. of shifts
      Dim nowShifted As Double
      nowShifted = Now - 6 / 24
      ReDim utilDates(1, 0)
      'first add all the dates + shifts
      For i = 1 To (Day(DateSerial(Year(nowShifted), Month(nowShifted) + 1, 1) - 1) * 3) 'initialise all utilisations to no. of utilised seconds in day
        ReDim Preserve utilDates(1, i - 1)
        'add the dates for the month into utilDates as well as the shift
        utilDates(0, i - 1) = DateSerial(Year(nowShifted), Month(nowShifted), (i - 1) \ 3 + 1) '\ = integer division
        If (i Mod 3) = 1 Then
          utilDates(0, i - 1) = utilDates(0, i - 1)
        ElseIf (i Mod 3) = 2 Then
          utilDates(0, i - 1) = utilDates(0, i - 1) + 8 / 24
        ElseIf (i Mod 3) = 0 Then
          utilDates(0, i - 1) = utilDates(0, i - 1) + 16 / 24
        End If
      Next i
      flag = 0
      currentshiftduration = 0
      currentShiftIndex = 0
      Worksheets("Casting Data").Range("N100").Value = "7-" + CStr(Position)
      For i = 1 To (Day(DateSerial(Year(nowShifted), Month(nowShifted) + 1, 1) - 1) * 3) 'initialise all utilisations to no. of utilised seconds in day
        'if utilDates(0, i - 1) includes the current time, then only add seconds already passed, else add total utilisation possible
        If i = (Day(DateSerial(Year(nowShifted), Month(nowShifted) + 1, 1) - 1) * 3) Then 'the last shift
          If nowShifted > utilDates(0, i - 1) Then
            utilDates(1, i - 1) = Round((nowShifted - utilDates(0, i - 1)) * 86400, 0)
          Else
            utilDates(1, i - 1) = 0 'since nowShifted obviously been incorporated earlier on
        End If
        Else 'not the last shift
          If (nowShifted > utilDates(0, i - 1)) And (nowShifted < utilDates(0, i)) Then
            utilDates(1, i - 1) = Round((nowShifted - utilDates(0, i - 1)) * 86400, 0)
            currentshiftduration = utilDates(1, i - 1)
            currentShiftIndex = i - 1
            flag = 1 'here on after shifts haven't happened yet, so can't make 28800
          Else
            If flag = 0 Then
              utilDates(1, i - 1) = 28800
            Else
              utilDates(1, i - 1) = 0
            End If
          End If
        End If
      Next i
      
      Worksheets("Casting Data").Range("N100").Value = "8-" + CStr(Position)
      'tempData always 1 size bigger than needed, so resize
      ReDim Preserve tempData(1, UBound(tempData, 2) - 1)
      
      'iterate through tempData, and subtract any cadences from relevant shift
      'the cadences that exist are the actual non-productive times
      For i = LBound(tempData, 2) To UBound(tempData, 2)
       flag = False
       k = -1
       dt = tempData(0, i)
       If (((dt - Int(dt)) * 86400) Mod 28800) = 0 Then 'if the timestamp sits on a shift split, then the cadence must come off the previous shift
         dt = dt - 1 / 3
       End If
       ds = tempData(1, i)
       For j = LBound(utilDates, 2) To UBound(utilDates, 2)
         If dt >= utilDates(0, j) Then
           k = j ' record the position since will iterate through all array indexes
         End If
       Next j
       If k >= 0 Then
         utilDates(1, k) = utilDates(1, k) - tempData(1, i)
       End If
      Next i
        
      Worksheets("Casting Data").Range("N100").Value = "9-" + CStr(Position)
      'convert utilisations to percentages, and shift the shift start times by 6 hours
      For i = LBound(utilDates, 2) To UBound(utilDates, 2)
        utilDates(0, i) = utilDates(0, i) + 6 / 24
        If i <> currentShiftIndex Then
          utilDates(1, i) = Round(utilDates(1, i) * 100 / 28800, 0)
        Else
          utilDates(1, i) = Round(utilDates(1, i) * 100 / currentshiftduration, 0)
        End If
        If utilDates(1, i) < 5 Then 'this sorted out in the spreadsheet itself
          utilDates(1, i) = ""
        End If
      Next i
        
      Dim y As Variant
      If Position = 1 Then
        ''need the first column of dates of utilDates
        Worksheets("Casting Data").Range("M4").Resize(UBound(utilDates, 2) - LBound(utilDates, 2) + 1, 2).Clear
        Worksheets("Casting Data").Range("M4").Resize(UBound(utilDates, 2) - LBound(utilDates, 2) + 1, 2).Value = Application.Transpose(utilDates)
      ElseIf Position = 2 Then
        y = Application.Index(utilDates, 2)
        Worksheets("Casting Data").Range("O4").Resize(UBound(y) - LBound(y) + 1, 1).Clear
        Worksheets("Casting Data").Range("O4").Resize(UBound(y) - LBound(y) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 3 Then
        y = Application.Index(utilDates, 2)
        Worksheets("Casting Data").Range("P4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Worksheets("Casting Data").Range("P4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 4 Then
        y = Application.Index(utilDates, 2)
        Worksheets("Casting Data").Range("Q4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Worksheets("Casting Data").Range("Q4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 5 Then
        y = Application.Index(utilDates, 2)
        Worksheets("Casting Data").Range("R4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Worksheets("Casting Data").Range("R4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 6 Then
        y = Application.Index(utilDates, 2)
        Worksheets("Casting Data").Range("S4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Worksheets("Casting Data").Range("S4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 7 Then
        y = Application.Index(utilDates, 2)
        Worksheets("Casting Data").Range("T4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Worksheets("Casting Data").Range("T4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 8 Then
        y = Application.Index(utilDates, 2)
        Worksheets("Casting Data").Range("U4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Worksheets("Casting Data").Range("U4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 9 Then
        y = Application.Index(utilDates, 2)
        Worksheets("Casting Data").Range("V4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Worksheets("Casting Data").Range("V4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 10 Then
        y = Application.Index(utilDates, 2)
        Worksheets("Casting Data").Range("W4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Worksheets("Casting Data").Range("W4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 11 Then
        y = Application.Index(utilDates, 2)
        Worksheets("Casting Data").Range("X4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Worksheets("Casting Data").Range("X4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 12 Then
        y = Application.Index(utilDates, 2)
        Worksheets("Casting Data").Range("Y4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Worksheets("Casting Data").Range("Y4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 13 Then
        y = Application.Index(utilDates, 2)
        Worksheets("Casting Data").Range("Z4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Worksheets("Casting Data").Range("Z4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 14 Then
        Worksheets("Casting Data").Range("N100").Value = "10-" + CStr(Position)
        y = Application.Index(utilDates, 2)
        Worksheets("Casting Data").Range("AA4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Worksheets("Casting Data").Range("AA4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      End If
    End If
  recset.Close
  Next Position
  'Update/run every 60 minutes
  Application.OnTime Now + TimeValue("00:03:00"), "Sheet2.GetUtilisation"
  Exit Sub
ThereWasAnError:
  'Error encountered
  Worksheets("Casting Data").Range("M4").Value = "Error getting data..."
End Sub
 
Last edited:
Upvote 0
Since the code is in the Casting Data sheet, you can refer to that sheet as Me rather than Worksheets("Casting Data"):

Code: 
Option Explicit

Sub GetUtilisation()
  'For querying of databases, need to first do following...
  'Tools > References > Check the checkbox in front of "Microsoft ActiveX Data Objects 2.5 Library" (or the latest available)
  
  Me.Range("N100").Value = "0"
  On Error GoTo ThereWasAnError
  
  'query the MySQL database and extract all cycle cadences
  'MySQL connection
  Dim conn As New ADODB.Connection
  Set conn = New ADODB.Connection
  Dim recset As New ADODB.Recordset
  Set recset = New ADODB.Recordset
  conn.Open "Provider=MSDASQL; Driver={MySQL ODBC 5.3 ANSI Driver};Server=192.168.2.10;Port=3306;Database=xxx;User=xxx;Password=xxx;Option=3"
  
  'extract all cadence values to then pull out rows that are greater than a set value
  'reason why not filtering first is because a cycle just before shift end < setValue might need to altered
  Dim tempData, cadenceData As Variant
  Dim query As String
  Dim i As Integer
  
  Dim util(1 To 31) As Variant 'array to hold non-utilisations for each 31 days
  Dim utilDates() As Variant 'array to hold dates of util array
  
  'loop through all data stored in variant array
  Const utilValue As Integer = 180 'the value above which time is now taken as non-utilisation in seconds
  Dim dt, dm As Double
  Dim ds As Long
  Dim j As Integer
  Dim k As Long
  
  For Position = 1 To 14 'all the positions of the machines
    Me.Range("N100").Value = "1-" + CStr(Position)
    'Retrieve only current month's data. 6am is the first shift on the first day, 6am 1st of new month ends the current month
    'any time from 6am to very first cycle > value is non-productive
    'any time from very last cycle > value is non-productive
    'shift timestamp 6 hours earlier to remove shift start offset of 6am
    query = "SELECT DATE_ADD(cycle_timestamp, INTERVAL -6 HOUR) AS cycle_timestamp, cadence FROM daq_i.cycle_cadence_pos" + CStr(Position) + " " & _
            "WHERE YEAR(DATE_ADD(cycle_timestamp, INTERVAL -6 HOUR)) = YEAR(now()) " & _
            "AND MONTH(DATE_ADD(cycle_timestamp, INTERVAL -6 HOUR)) = MONTH(now())"
    conn.CursorLocation = adUseClient
    recset.Open query, conn
  
    Me.Range("N100").Value = "2-" + CStr(Position)
    '0) insert the current timestamp as the very last row of the retrieved data, then include in processing
    '1) add shift changes if needed before very first row timestamp
    '2) adjust very first row of data to reflect cadence to last inserted row of shifts
    '3) iterate through all rows of data, if cadence < value, set to zero
    '   reason for doing this before splitting cadence over shifts, is because after split each part might be < value, and don't want to lose this
    '4) insert an extra row at every shift change (if not existing) that splits the stoppage across the shift change into the last cycle of previous shift and shift change
    '   then update the first cycle's cadence to reflect the split
    rw = recset.RecordCount
    If rw <> 0 Then
      Me.Range("N100").Value = "3-" + CStr(Position)
      cadenceData = recset.GetRows 'place query data into array
      
      '0) insert the current timestamp as the very last row of the retrieved data, then include in processing
      ReDim Preserve cadenceData(1, UBound(cadenceData, 2) + 1)
      ub = UBound(cadenceData, 2)
      cadenceData(0, ub) = Now - 6 / 24 'remember everything shifted backwards by 6 hours
      sf = cadenceData(0, ub) - cadenceData(0, ub - 1)
      cadenceData(1, ub) = Round((cadenceData(0, ub) - cadenceData(0, ub - 1)) * 86400, 0)
      
      '1) add shift changes if needed before very first row timestamp
      dt = DateSerial(Year(Now), Month(Now), 1) 'the 1st of current month, 12am
      dm = cadenceData(0, 0)  'get very first timestamp recorded
      ReDim tempData(1, 0)
      i = 0
      While dt < dm
        tempData(0, i) = dt
        If i = 0 Then
         tempData(1, i) = 0 ' since this measures the cadence to previous cycle. Because very 1st cycle, doesn't matter what happened before
        Else
         tempData(1, i) = 28800 '=hours
        End If
        dt = dt + 1 / 3 '8hrs = 1/3 day
        i = i + 1
        ReDim Preserve tempData(1, UBound(tempData, 2) + 1)
      Wend
      
      Me.Range("N100").Value = "4-" + CStr(Position)
      '2) adjust very first row of data to reflect cadence to last inserted row of shifts
      'dt contains the next shift timestamp that would have been inserted so decrease by 8 hours if i > 0
      If i > 0 Then
        dt = dt - 1 / 3
      End If
      cadenceData(1, 0) = Round((cadenceData(0, 0) - dt) * 86400, 0)
      
      '3) iterate through all rows of data, if cadence < value, set to zero
      '   reason for doing this before splitting cadence over shifts, is because after split each part might be < value, and don't want to lose this
      For i = LBound(cadenceData, 2) To UBound(cadenceData, 2)
        If cadenceData(1, i) < utilValue Then
          cadenceData(1, i) = 0
        End If
      Next i
      
      Me.Range("N100").Value = "5-" + CStr(Position)
      '4) insert an extra row at every shift change (if not existing) that splits the stoppage across the shift change into the last cycle of previous shift and shift change
      '   then update the first cycle's cadence to reflect the split
      j = UBound(tempData, 2)  'first index where rows will be moved into
      dt = dt + 1 / 3 'look for the next shift split
      flag = 0
      For i = LBound(cadenceData, 2) To UBound(cadenceData, 2)
        If cadenceData(0, i) < dt Then 'dt = the shift split
          tempData(0, j) = cadenceData(0, i)
          tempData(1, j) = cadenceData(1, i)
          ReDim Preserve tempData(1, UBound(tempData, 2) + 1)
          j = j + 1
        ElseIf cadenceData(0, i) > dt Then 'if cadenceData(0, i) "=" td, then doesn't need a shift split as this already is one
          While cadenceData(0, i) > dt 'the might be more than 1 shift splits missing
            flag = 1
            tempData(0, j) = dt
            If cadenceData(1, i) > 0 Then 'all cadences already determined previously if > utilValue - see 3)
              tempData(1, j) = Round((tempData(0, j) - tempData(0, j - 1)) * 86400, 0)
            Else
              tempData(1, j) = 0
            End If
            dt = dt + 1 / 3 'look for the next shift split
            ReDim Preserve tempData(1, UBound(tempData, 2) + 1)
            j = j + 1
          Wend
        End If
        If flag = 1 Then 'test if added in shift splits, because then still needing to add in the row that was being compared against
          flag = 0
          tempData(0, j) = cadenceData(0, i)
          If cadenceData(1, i) > 0 Then 'all cadences already determined previously if > utilValue - see 3)
            tempData(1, j) = Round((cadenceData(0, i) - (dt - 1 / 3)) * 86400, 0)
          Else
            tempData(1, j) = 0
          End If
          ReDim Preserve tempData(1, UBound(tempData, 2) + 1)
          j = j + 1
        End If
      Next i
      
      Me.Range("N100").Value = "6-" + CStr(Position)
      'calculate utilisation by summing up totals for each shift
      'for the last shift that has time allocated, max time is how long has passed in shift already
      'get how many days in current month, x 3 = no. of shifts
      Dim nowShifted As Double
      nowShifted = Now - 6 / 24
      ReDim utilDates(1, 0)
      'first add all the dates + shifts
      For i = 1 To (Day(DateSerial(Year(nowShifted), Month(nowShifted) + 1, 1) - 1) * 3) 'initialise all utilisations to no. of utilised seconds in day
        ReDim Preserve utilDates(1, i - 1)
        'add the dates for the month into utilDates as well as the shift
        utilDates(0, i - 1) = DateSerial(Year(nowShifted), Month(nowShifted), (i - 1) \ 3 + 1) '\ = integer division
        If (i Mod 3) = 1 Then
          utilDates(0, i - 1) = utilDates(0, i - 1)
        ElseIf (i Mod 3) = 2 Then
          utilDates(0, i - 1) = utilDates(0, i - 1) + 8 / 24
        ElseIf (i Mod 3) = 0 Then
          utilDates(0, i - 1) = utilDates(0, i - 1) + 16 / 24
        End If
      Next i
      flag = 0
      currentshiftduration = 0
      currentShiftIndex = 0
      Me.Range("N100").Value = "7-" + CStr(Position)
      For i = 1 To (Day(DateSerial(Year(nowShifted), Month(nowShifted) + 1, 1) - 1) * 3) 'initialise all utilisations to no. of utilised seconds in day
        'if utilDates(0, i - 1) includes the current time, then only add seconds already passed, else add total utilisation possible
        If i = (Day(DateSerial(Year(nowShifted), Month(nowShifted) + 1, 1) - 1) * 3) Then 'the last shift
          If nowShifted > utilDates(0, i - 1) Then
            utilDates(1, i - 1) = Round((nowShifted - utilDates(0, i - 1)) * 86400, 0)
          Else
            utilDates(1, i - 1) = 0 'since nowShifted obviously been incorporated earlier on
        End If
        Else 'not the last shift
          If (nowShifted > utilDates(0, i - 1)) And (nowShifted < utilDates(0, i)) Then
            utilDates(1, i - 1) = Round((nowShifted - utilDates(0, i - 1)) * 86400, 0)
            currentshiftduration = utilDates(1, i - 1)
            currentShiftIndex = i - 1
            flag = 1 'here on after shifts haven't happened yet, so can't make 28800
          Else
            If flag = 0 Then
              utilDates(1, i - 1) = 28800
            Else
              utilDates(1, i - 1) = 0
            End If
          End If
        End If
      Next i
      
      Me.Range("N100").Value = "8-" + CStr(Position)
      'tempData always 1 size bigger than needed, so resize
      ReDim Preserve tempData(1, UBound(tempData, 2) - 1)
      
      'iterate through tempData, and subtract any cadences from relevant shift
      'the cadences that exist are the actual non-productive times
      For i = LBound(tempData, 2) To UBound(tempData, 2)
       flag = False
       k = -1
       dt = tempData(0, i)
       If (((dt - Int(dt)) * 86400) Mod 28800) = 0 Then 'if the timestamp sits on a shift split, then the cadence must come off the previous shift
         dt = dt - 1 / 3
       End If
       ds = tempData(1, i)
       For j = LBound(utilDates, 2) To UBound(utilDates, 2)
         If dt >= utilDates(0, j) Then
           k = j ' record the position since will iterate through all array indexes
         End If
       Next j
       If k >= 0 Then
         utilDates(1, k) = utilDates(1, k) - tempData(1, i)
       End If
      Next i
        
      Me.Range("N100").Value = "9-" + CStr(Position)
      'convert utilisations to percentages, and shift the shift start times by 6 hours
      For i = LBound(utilDates, 2) To UBound(utilDates, 2)
        utilDates(0, i) = utilDates(0, i) + 6 / 24
        If i <> currentShiftIndex Then
          utilDates(1, i) = Round(utilDates(1, i) * 100 / 28800, 0)
        Else
          utilDates(1, i) = Round(utilDates(1, i) * 100 / currentshiftduration, 0)
        End If
        If utilDates(1, i) < 5 Then 'this sorted out in the spreadsheet itself
          utilDates(1, i) = ""
        End If
      Next i
        
      Dim y As Variant
      If Position = 1 Then
        ''need the first column of dates of utilDates
        Me.Range("M4").Resize(UBound(utilDates, 2) - LBound(utilDates, 2) + 1, 2).Clear
        Me.Range("M4").Resize(UBound(utilDates, 2) - LBound(utilDates, 2) + 1, 2).Value = Application.Transpose(utilDates)
      ElseIf Position = 2 Then
        y = Application.Index(utilDates, 2)
        Me.Range("O4").Resize(UBound(y) - LBound(y) + 1, 1).Clear
        Me.Range("O4").Resize(UBound(y) - LBound(y) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 3 Then
        y = Application.Index(utilDates, 2)
        Me.Range("P4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Me.Range("P4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 4 Then
        y = Application.Index(utilDates, 2)
        Me.Range("Q4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Me.Range("Q4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 5 Then
        y = Application.Index(utilDates, 2)
        Me.Range("R4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Me.Range("R4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 6 Then
        y = Application.Index(utilDates, 2)
        Me.Range("S4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Me.Range("S4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 7 Then
        y = Application.Index(utilDates, 2)
        Me.Range("T4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Me.Range("T4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 8 Then
        y = Application.Index(utilDates, 2)
        Me.Range("U4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Me.Range("U4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 9 Then
        y = Application.Index(utilDates, 2)
        Me.Range("V4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Me.Range("V4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 10 Then
        y = Application.Index(utilDates, 2)
        Me.Range("W4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Me.Range("W4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 11 Then
        y = Application.Index(utilDates, 2)
        Me.Range("X4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Me.Range("X4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 12 Then
        y = Application.Index(utilDates, 2)
        Me.Range("Y4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Me.Range("Y4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 13 Then
        y = Application.Index(utilDates, 2)
        Me.Range("Z4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Me.Range("Z4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      ElseIf Position = 14 Then
        Me.Range("N100").Value = "10-" + CStr(Position)
        y = Application.Index(utilDates, 2)
        Me.Range("AA4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Clear
        Me.Range("AA4").Resize(UBound(y, 1) - LBound(y, 1) + 1, 1).Value = Application.Transpose(y)
      End If
    End If
  recset.Close
  Next Position
  'Update/run every 60 minutes
  Application.OnTime Now + TimeValue("00:03:00"), "Sheet2.GetUtilisation"
  Exit Sub
ThereWasAnError:
  'Error encountered
  Me.Range("M4").Value = "Error getting data..."
End Sub
 
Upvote 0
Thank you Rory, that seems to have done the trick, I really appreciate your quick and willing response.
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
code not executing in 1 particular remote desktop
Replies
3
Views
97
JEC
JEC
W
  • Solved
Another Type Mismatch reading text file
Replies
3
Views
371
myall_blues
myall_blues
R
  • Solved
Run-Time Error '9'; Subscript out of range
Replies
2
Views
261
Roland Hoelscher
R
P
  • Question Question
Run-Time error '-2147467259 (80004005)': Method 'InsertPictureInCell' of object 'Range' failed
Replies
3
Views
304
PopeScooby
P
L
  • Question Question
VBA to autosave and close after a set amount of time
Replies
3
Views
580
Anthony47
A

Forum statistics

Threads
1,223,903
Messages
6,175,279
Members
452,630
Latest member
OdubiYouth

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top