CODEWITHSUNDEEP
excelvba
diem_L
diem_L

Reputation: 399

Find closest Date to specific Date

I have two Tables.

Table1 goes from A1:F10 and shows the machine assignment.
Table2 goes from G1:K10 and shows the storage for the machines.

With a button I want to simulate which storage should be used for which machine.

In column C stands the date when the machine has to be built. In Column I stands the date when the storage is ready to use.

For example: The first machine has to start on 08/15/2018. How can I check which date in Column I is the closest to 08/15/2018?

This is my code so far:

Private Sub CommandButton1_Click()
    Dim lastrow as Long

    lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

    for a = 1 to lastrow
        If Cells(a, 1) = "Machine Name" And _    ' Find the specific machine
        Cells(a, 4) = "" Then                    ' In this cell the serial number of the storage should be added
            ' Now check if Storage for this machine is ready to use.
            For b = 1 to lastrow
                If Cells(b, 8) = "123" And _    ' Serial Number of the Storage
                Cells(b, 10) = "" Then          ' In this Cell serial number of the machine should be added
                    ' Here it should check which Date in Column I is the closest to the date in Column C
                    Cells(a, 4).Value = Cells(b, 8)
                    Cells(b, 10).Value = Cells(a, 2)
               End If
           Next b
       End If
    Next a
End Sub

I tried to change the code from Find closest date to current date in VBA.

In the picture you can see an example how the table looks:

enter image description here

Upvotes: 0

Views: 3801

Answers (2)

iamanigeeit
iamanigeeit

Reputation: 834

With your example, im assuming you want

  1. Start = 15.06.2018, Ende = 14.03.2018
  2. Start = 25.08.2018, Ende = 26.07.2018

Add this Function and call it like YourCell.Value = getClosestDateBefore(StartCell.Value, Range("I2:I9"))

Function getClosestDateBefore(d As Date, RefDateRange As Range) As Date
    Dim i As Long, ref_date As Date, diff As Double, best_diff As Double
    best_diff = -10000000
    With RefDateRange
        For i = 1 To .Cells.Count
            ref_date = .Cells(i).Value2
            diff = ref_date - d
            If diff < 0 And diff > best_diff Then
                best_diff = diff
                getClosestDateBefore = ref_date
            End If
        Next i
    End With
End Function

Upvotes: 0

T. Nesset
T. Nesset

Reputation: 417

you didn't specify where you want the closest date before start so i just added the date as a comment to the start date in column C.

Sub FindClosestBeforeDate()
    Dim ws As Worksheet
    Dim lLastReadyUsed As Long
    Dim lLastStartUsed As Long
    Dim dt As String
    Dim temp As Variant

    Set ws = Application.ThisWorkbook.ActiveSheet
    lLastStartUsed = ws.Cells(Rows.Count, "C").End(xlUp).Row
    lLastReadyUsed = ws.Cells(Rows.Count, "I").End(xlUp).Row

    'Delete previous comments
    For l = 2 To lLastStartUsed
        If Not Range("c" & l).Comment Is Nothing Then
            ws.Range("C" & l).Comment.Delete
        End If
    Next l

    'add comments with closeste date before startdate
    For l = 2 To lLastStartUsed
        For i = 2 To lLastReadyUsed
            If DateDiff("D", ws.Range("C" & l).value, ws.Range("I" & i).value) < 0 Then
                If IsEmpty(temp) Then
                    temp = DateDiff("D", ws.Range("C" & 3).value, ws.Range("I" & i).value)
                    dt = ws.Range("I" & i).value
                ElseIf temp < DateDiff("D", ws.Range("C" & 3).value, ws.Range("I" & i).value) Then
                    temp = DateDiff("D", ws.Range("C" & 3).value, ws.Range("I" & i).value)
                    dt = ws.Range("I" & i).value
                End If
            End If
        Next i
        temp = Empty
        ws.Range("C" & l).AddComment dt
    Next l
End Sub

Hope this helps you out

Upvotes: 2

Related Questions