简体   繁体   中英

Checking if the time is within a specific range in vba

I am trying to automate a tracking sheet that tracks accurate hours of equipment per task performed.

For simplicity, let's assume that we got the following tables for tasks and equipment:

Tasks table:

Task Description Assigned Hours
123 something here [USERINPUT]

Equipment Table:

Equipment Start Time End Time
equip1 7:00:00 AM 9:00:00 AM

The assigned hours uses the following code to get the user input:

For i = 1 To numProduction

    hoursAssigned = InputBox(ThisWorkbook.Sheets("Data").Range("E" & i + 47).Value,    "Assign hours to the following task", 1)
    ThisWorkbook.Sheets("data").Range("H" & i + 47).Value = hoursAssigned

Next i

So let's say that the user inputted 1 hour for this task. The outcome should be as follows:

Task Equipment Start Time End Time
123 equip1 7:00:00 AM 8:00:00 AM

I tried to use the following code, but it doesn't work and I am not sure how to approach

For e = 26 To 46 'this is the specific range of cells that the equipment gets exported from another excel         
    equip = ThisWorkbook.Sheets("data").Range("B" & e).Value                
    startTime = ThisWorkbook.Sheets("data").Range("F" & e).Value                
    endTime = ThisWorkbook.Sheets("data").Range("H" & e).Value                                
    
    remainingHours = endTime - startTime                                
    
    If Not equip = "" Then                                        
        For j = 48 To rowData ' rowData is the final row the data is                       
            phasecode = ThisWorkbook.Sheets("data").Range("B" & j).Value 'task column                      
            phasecodeAssignedHours = ThisWorkbook.Sheets("data").Range("H" & j).Value / 24 'assigned hours
            Equipment = ThisWorkbook.Sheets("data").Range("B" & e).Value                                                
            
            'this the part of the code that i am trying to figure out
            usualStartTime = 7 / 24                        
            addedHours = usualStartTime + phasecodeAssignedHours                                                
            If startTime <= usualStartTime And endTime >= addedHours Then                            
                MsgBox (startTime * 24 & Chr(10) & endTime * 24)                                
            End If                                                                                                
            
            'my code that places the result into the excel here
            'my code that formats the placement here
        Next j
    End If                             
Next e

Edit 1:

@CDP1802 The imported tables are a little bit more detailed than the ones I described in my problem, but here they are:

Date:

在此处输入图像描述

Employee: 在此处输入图像描述

Equipment: 在此处输入图像描述

Production (tasks): 在此处输入图像描述

The equipment section gets analyzed into the following on another page called "EquipmentResults": 在此处输入图像描述

Edit 2: Please check edit 3 for a more in-depth explanation, although it does use a different example.

Please bare with my poor English and weak description of the question. I will try to clarify even more in the comments if needed.

Table 1: (This table is imported, and gets placed in worksheet "Data")

Name Total Hours Start Time End Time
Equipment 1 2 7:00:00 AM 9:00:00 AM
Equipment 2 8 9:00:00 AM 5:00:00 PM
Equipment 3 10 7:00:00 AM 5:00:00 PM

Table 2: (This table is imported, and gets placed in worksheet "Data")

Task # Description Quantatity
1.000 task 1 description 5
2.000 task 2 description 15

I have made a code that turns the previous two tables into the following table:

Task # Date Name Start Time End Time
1.000 01/20/2021 Equipment 1 7:00:00 AM 9:00:00 AM
2.000 01/20/2021 Equipment 1 7:00:00 AM 9:00:00 AM
1.000 01/20/2021 Equipment 2 9:00:00 AM 5:00:00 PM
2.000 01/20/2021 Equipment 2 9:00:00 AM 5:00:00 PM
1.000 01/20/2021 Equipment 3 7:00:00 AM 5:00:00 PM
2.000 01/20/2021 Equipment 3 7:00:00 AM 5:00:00 PM

I am struggling to make it turn into this table though (which should be the result):

Task # Date Name Start Time End Time
1.000 01/20/2021 Equipment 1 7:00:00 AM 9:00:00 AM
2.000 01/20/2021 Equipment 1 9:00:00 AM 9:00:00 AM
1.000 01/20/2021 Equipment 2 9:00:00 AM 2:00:00 PM
2.000 01/20/2021 Equipment 2 2:00:00 PM 5:00:00 PM
1.000 01/20/2021 Equipment 3 7:00:00 AM 12:00:00 PM
2.000 01/20/2021 Equipment 3 12:00:00 PM 5:00:00 PM

Edit 3 : 在此处输入图像描述

在此处输入图像描述

Create 2 tables on your data sheet like this. Name them Table1 for equipment and Table2 for tasks

If the assigned hours is blank it will prompt you for values. The results are written to sheet EquipmentResults

Option Explicit

Sub ProcessData()

    Dim wb As Workbook, wsData As Worksheet, wsOut As Worksheet
    Dim tb1 As ListObject, tb2 As ListObject, rng As Range
    Dim TaskTitle As String, sTaskHrs As String, s As String
    Dim dt As Date, arTask, arEquip
    Dim r As Long, e As Long, t As Long
  
    ' assign hours to tasks
    Set wb = ThisWorkbook
    Set wsData = wb.Sheets("Data")
    Set tb2 = wsData.ListObjects("Table2") ' tasks
    For Each rng In tb2.DataBodyRange.Rows
        TaskTitle = rng.Cells(1, 1) & vbCrLf & rng.Cells(1, 2)
        If IsEmpty(rng.Cells(1, 3)) Then
            s = InputBox("Enter Hours for Task " & TaskTitle, "Task Hrs")
            If IsNumeric(s) Then rng.Cells(1, 3) = s
        End If
    Next
    arTask = tb2.DataBodyRange.Value2
    
    ' get date from cell B2
    dt = wsData.Range("B2").Value2
  
    ' generate Equipment Results
    Dim taskStart As Date, taskEnd As Date, taskDur As Single
    Dim equipStart As Date, equipEnd As Date, remain As Single
    Dim prevTaskEnd As Date
  
    Set wsOut = wb.Sheets("EquipmentResults")
    wsOut.Cells.Clear
    With wsOut.Range("A1:E1")
        .Value2 = Array("TAsk #", "Date", "Name", "Start Time", "End Time")
        .Interior.Color = RGB(200, 200, 200)
        .Font.Bold = True
    End With
  
    r = 2
    Set tb1 = wsData.ListObjects("Table1") ' Equip
    arEquip = tb1.DataBodyRange.Value2
    ' each equip
    For e = 1 To UBound(arEquip)
        
        equipStart = DateAdd("n", arEquip(e, 2) * 24 * 60, dt)
        equipEnd = DateAdd("n", arEquip(e, 3) * 24 * 60, dt)
        remain = 0
  
        'each task
        For t = 1 To UBound(arTask)
            taskDur = arTask(t, 3)
            
            ' was there spare hours on last task
            If remain > 0 Then
                taskStart = prevTaskEnd
            Else
                remain = 0
                taskStart = equipStart ' normal start time
            End If
             
            ' calculate task end
            taskEnd = DateAdd("h", taskDur, taskStart)
  
            ' does task end before equipment
            remain = DateDiff("h", taskEnd, equipEnd)
            If remain < 0 Then
                taskEnd = equipEnd
            End If

            ' result
            With wsOut
               .Cells(r, 1) = arTask(t, 1) ' task
               .Cells(r, 2) = dt ' date
               .Cells(r, 3) = arEquip(e, 1) ' equipment name
               .Cells(r, 4) = taskStart ' date
               .Cells(r, 5) = taskEnd ' date
            End With
            prevTaskEnd = taskEnd
            r = r + 1
        Next
    Next

    ' Sort data by equip, task
    With wsOut.Sort
        With .SortFields
            .Clear
            .Add Key:=wsOut.Range("A2:A" & r), SortOn:=xlSortOnValues, _
               Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=wsOut.Range("C2:C" & r), SortOn:=xlSortOnValues, _
               Order:=xlAscending, DataOption:=xlSortNormal
        End With
        .SetRange wsOut.Range("A1:E" & r)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    wsOut.Columns("D:E").NumberFormat = "hh:mm AM/PM" '"m/d/yyyy h:mm"
    wsOut.Columns("A:E").AutoFit
    MsgBox r & " rows written to " & wsOut.Name, vbInformation

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM