VBA that will insert column D with a Yes when the customer places an order that is within 24 hours of the their previous

dtopinka

New Member
Joined
Nov 2, 2020
Messages
18
Office Version
  1. 2013
Platform
  1. Windows
we charge customers for abusing our delivery service. what i need help with is creating the code that will insert a "Yes" in Column D when a customer (name column) requests an order within 24 hours of his last. Example would be rows 7 and 8 should both have a Yes in their D column cell. Thank you in advance!

1604352066247.png
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Give this code a go, it assumes data is sorted by name, date and time:

VBA Code:
Sub timenamecompare()
Dim lr, i, j, lrn, u As Long
Dim Rng, rngr, x As Range
Dim sht As String

lr = Cells(Rows.Count, "I").End(xlUp).Row
sht = "sheet1"
Set Rng = Range("A1:R" & lr)
Set rngr = Range("R2:R" & lr - 1)

For Each x In rngr
    If x.Value = x.Offset(1, 0).Value And _
Abs(DateDiff("n", Format((x.Offset(0, -9).Value & " " & Format(x.Offset(0, -7).Value, "HH:MM")), "dd-mm-yy HH:MM"), Format((x.Offset(1, -9).Value & " " & Format(x.Offset(1, -7).Value, "HH:MM")), "dd-mm-yy HH:MM"))) < (1440) _
And Abs(DateDiff("n", Format((x.Offset(0, -9).Value & " " & Format(x.Offset(0, -7).Value, "HH:MM")), "dd-mm-yy HH:MM"), Format((x.Offset(1, -9).Value & " " & Format(x.Offset(1, -7).Value, "HH:MM")), "dd-mm-yy HH:MM"))) <> 0 Then
    x.Offset(1, -14).Value = "Y"
    End If
Next

End Sub
 
Upvote 0
Give this code a go, it assumes data is sorted by name, date and time:

VBA Code:
Sub timenamecompare()
Dim lr, i, j, lrn, u As Long
Dim Rng, rngr, x As Range
Dim sht As String

lr = Cells(Rows.Count, "I").End(xlUp).Row
sht = "sheet1"
Set Rng = Range("A1:R" & lr)
Set rngr = Range("R2:R" & lr - 1)

For Each x In rngr
    If x.Value = x.Offset(1, 0).Value And _
Abs(DateDiff("n", Format((x.Offset(0, -9).Value & " " & Format(x.Offset(0, -7).Value, "HH:MM")), "dd-mm-yy HH:MM"), Format((x.Offset(1, -9).Value & " " & Format(x.Offset(1, -7).Value, "HH:MM")), "dd-mm-yy HH:MM"))) < (1440) _
And Abs(DateDiff("n", Format((x.Offset(0, -9).Value & " " & Format(x.Offset(0, -7).Value, "HH:MM")), "dd-mm-yy HH:MM"), Format((x.Offset(1, -9).Value & " " & Format(x.Offset(1, -7).Value, "HH:MM")), "dd-mm-yy HH:MM"))) <> 0 Then
    x.Offset(1, -14).Value = "Y"
    End If
Next

End Sub

thanks for the reply.. the data is sorted by an account number but i can adjust before running this step if needed.. that said.. this code returns a run time error..
1604418226923.png
 
Upvote 0
The code is very dependent on the format of each time column, especially I and K. Please use the xlbb tool to share your spreadsheet , or place it on a share drive and share the link. Thanks
 
Upvote 0
Added Sorting into the code and improved robustness of time code

VBA Code:
Sub timenamecompare2()
Dim lr As Long
Dim rngr, x As Range
Dim sht As String

lr = Cells(Rows.Count, "I").End(xlUp).Row
sht = "sheet1"
Set rngr = Range("R2:R" & lr - 1)

With ActiveSheet.Sort
     .SortFields.Add Key:=Range("R1"), Order:=xlDescending
     .SortFields.Add Key:=Range("I1"), Order:=xlAscending
     .SortFields.Add Key:=Range("K1"), Order:=xlAscending
     .SetRange Range("A1:R" & lr)
     .Header = xlYes
     .Apply
End With

For Each x In rngr
    If x.Value = x.Offset(1, 0).Value And _
Abs(DateDiff("n", Format((Format(x.Offset(0, -9).Value, "mm-dd-yy") & " " & Format(x.Offset(0, -7).Value, "HH:MM")), "mm-dd-yy HH:MM"), Format((Format(x.Offset(1, -9).Value, "mm-dd-yy") & " " & Format(x.Offset(1, -7).Value, "HH:MM")), "mm-dd-yy HH:MM"))) < (1440) Then
    x.Offset(1, -14).Value = "Y"
    End If
Next

End Sub
 
Upvote 0
@ManiacB
When using SortFields, you should always clear the sortfields, before adding new ones otherwise you will end up getting errors when opening the workbook.
 
Upvote 0
Like
VBA Code:
With ActiveSheet.Sort
   .SortFields.Clear
   .SortFields.Add Key:=Range("R1"), Order:=xlDescending
 
Upvote 0
Alright, give this a try

VBA Code:
Option Explicit

Sub timenamecompare3()
Dim lr, i As Long

lr = Cells(Rows.Count, "H").End(xlUp).Row

For i = lr To 2 Step -1

If Cells(i, 18).Value = Cells(i + 1, 18).Value And _
Abs(DateDiff("n", Cells(i, 8).Value, Cells(1 + i, 8).Value)) < 1440 And _
Abs(DateDiff("n", Cells(i, 8).Value, Cells(1 + i, 8).Value)) <> 0 Then
    Cells(i, 4).Value = "Yes"
    End If
Next
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,511
Messages
6,114,054
Members
448,543
Latest member
MartinLarkin

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