Excel Formula-Macro

W.E.B
W.E.B used Ask the Experts™
on
Hello,
can you please help with a formula for below conditions,
I need to put this into a macro.
Any help is appreciated. (Sample Attached)

IF Service (Column AF) =        107      AND DateTime (Column C)  < =      Date @ 12-00-00.00      Then (Column D) =       DateTime + 2 HRS
IF Service (Column AF) =        109      AND DateTime (Column C)  < =      Date @ 12-00-00.00      Then (Column D) =       DateTime + 5 HRS
IF Service (Column AF) =        313      AND DateTime (Column C)  < =      Date @ 12-00-00.00      Then (Column D) =       DateTime + 1 Day @ 18-00-00.00
IF Service (Column AF) =        123      AND DateTime (Column C)  < =      Date @ 12-00-00.00      Then (Column D) =       DateTime + 1 Day @ 12-00-00.00
IF Service (Column AF) =        124      AND DateTime (Column C)  < =      Date @ 12-00-00.00      Then (Column D) =       DateTime + 1 Day @ 17-00-00.00
                              
IF Service (Column AF) =      107      AND DateTime (Column C)  < =      Date @ 17-00-00.00      Then (Column D) =       DateTime + 1 Day @ 10-00-00.00
IF Service (Column AF) =      109      AND DateTime (Column C)  < =      Date @ 17-00-00.00      Then (Column D) =       DateTime + 1 Day @ 13-00-00.00
IF Service (Column AF) =      313      AND DateTime (Column C)  < =      Date @ 17-00-00.00      Then (Column D) =       DateTime + 1 Day @ 18-00-00.00
IF Service (Column AF) =      123      AND DateTime (Column C)  < =      Date @ 17-00-00.00      Then (Column D) =       DateTime + 1 Day @ 12-00-00.00
IF Service (Column AF) =      124      AND DateTime (Column C)  < =      Date @ 17-00-00.00      Then (Column D) =       DateTime + 1 Day @ 17-00-00.00
Sample.xlsx
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solutions Only
Ejgil Hedegaard
Commented:
Try this

Option Explicit

Sub InsertDateTime()
    Dim rw As Long, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    For rw = 2 To ws.Range("C1048576").End(xlUp).Row
        If ws.Range("C" & rw) <> "" Then
            If TimeValue(ws.Range("C" & rw)) <= TimeValue("12:00") Then
                Select Case ws.Range("AF" & rw)
                    Case 107
                        ws.Range("D" & rw) = ws.Range("C" & rw) + TimeValue("02:00")
                    Case 109
                        ws.Range("D" & rw) = ws.Range("C" & rw) + TimeValue("05:00")
                    Case 313
                        ws.Range("D" & rw) = DateValue(ws.Range("C" & rw)) + 1 + TimeValue("18:00")
                    Case 123
                        ws.Range("D" & rw) = DateValue(ws.Range("C" & rw)) + 1 + TimeValue("12:00")
                    Case 124
                        ws.Range("D" & rw) = DateValue(ws.Range("C" & rw)) + 1 + TimeValue("17:00")
                    Case Else
                        ws.Range("D" & rw) = "No service match"
                End Select
            ElseIf TimeValue(ws.Range("C" & rw)) <= TimeValue("17:00") Then
                Select Case ws.Range("AF" & rw)
                    Case 107
                        ws.Range("D" & rw) = DateValue(ws.Range("C" & rw)) + 1 + TimeValue("10:00")
                    Case 109
                        ws.Range("D" & rw) = DateValue(ws.Range("C" & rw)) + 1 + TimeValue("13:00")
                    Case 313
                        ws.Range("D" & rw) = DateValue(ws.Range("C" & rw)) + 1 + TimeValue("18:00")
                    Case 123
                        ws.Range("D" & rw) = DateValue(ws.Range("C" & rw)) + 1 + TimeValue("12:00")
                    Case 124
                        ws.Range("D" & rw) = DateValue(ws.Range("C" & rw)) + 1 + TimeValue("17:00")
                    Case Else
                        ws.Range("D" & rw) = "No service match"
                End Select
            Else
                ws.Range("D" & rw) = "Time > 17:00"
            End If
        End If
    Next rw
End Sub

Open in new window

Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Commented:
You may try something like this.....

Sub AddTimeAccordingToService()
Dim lr As Long
Dim rng As Range, cell As Range
lr = Cells(Rows.Count, "AF").End(xlUp).Row
Set rng = Range("AF2:AF" & lr)
For Each cell In rng
    If cell <> "" Then
        Select Case cell
            Case 107
                If TimeValue(Cells(cell.Row, "C")) <= TimeValue("12:00:00") Then
                    Cells(cell.Row, "D") = DateAdd("h", 2, Cells(cell.Row, "C"))
                Else
                    Cells(cell.Row, "D") = DateValue(DateAdd("d", 1, Cells(cell.Row, "C"))) + TimeValue("10:00:00")
                End If
            Case 109
                If TimeValue(Cells(cell.Row, "C")) <= TimeValue("12:00:00") Then
                    Cells(cell.Row, "D") = DateAdd("h", 5, Cells(cell.Row, "C"))
                Else
                    Cells(cell.Row, "D") = DateValue(DateAdd("d", 1, Cells(cell.Row, "C"))) + TimeValue("13:00:00")
                End If
            Case 313
                Cells(cell.Row, "D") = DateValue(DateAdd("d", 1, Cells(cell.Row, "C"))) + TimeValue("18:00:00")
            Case 123
                Cells(cell.Row, "D") = DateValue(DateAdd("d", 1, Cells(cell.Row, "C"))) + TimeValue("12:00:00")
            Case 124
                Cells(cell.Row, "D") = DateValue(DateAdd("d", 1, Cells(cell.Row, "C"))) + TimeValue("17:00:00")
        End Select
    End If
Next cell
Range("AF:AF").NumberFormat = "yyyy-mm-dd hh-mm-ss.ss"
End Sub

Open in new window


For details refer to the attached workbook and click on the button "Click Here to run the code and see if you get the desired output.
AddTimeAsPerService.xlsm
W.E.B

Author

Commented:
Thank you very much guys,
both worked.
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
You're welcome. Glad we could help.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial