Excel Formula-Macro

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
W.E.BAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ejgil HedegaardCommented:
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

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
W.E.BAuthor Commented:
Thank you very much guys,
both worked.
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome. Glad we could help.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.