VBA search in range of dates if current date already exists-CodePudding

i searched all over the internet to find a solution to my problem, but i am still struggling to find one. I am a newbie to vba so i dont know how to solve the following problem.

After clicking a Button, i want to check over a range of cells if the current date is already in it. If it is already present, the loop should end and nothing should happen. If it is not in it, it has to insert the date into the next empty cell it finds in that range.

I tried a "For each Method" already but i am not getting the results that i want from it. It checks every date in the range and gives a respond to every single cell. But I only want to know if it is already present or not and not a response for every cell thats not the current date.

Private Function DateUpdateWithCheck()
    Dim ws As Worksheet
    Dim wb As Workbook

    Dim myDate As Date
    Dim searchrange As Range
    Dim cell As Range
    Dim lRow As Long

    myDate = Date

    Set ws = ThisWorkbook.Worksheets("History")
    ws.Activate

    Set searchrange = ws.Range("CA1:CC1")

    For Each cell In searchrange
        If cell.Value = myDate Then
            MsgBox ("Date already in it. End the loop")
            Exit For
        Else
            MsgBox ("Date is not in it. Insert Date.")
            GoTo yesinsert
        End If
    Next


yesinsert:

    With ws
        lRow = Range("C1").End(xlToRight).Offset(0, 1).Select
    
        ActiveCell.Value = Date
        'ActiveCell.EntireColumn.Copy
        'ActiveCell.EntireColumn.PasteSpecial xlPasteValues
    End With
End Function

CodePudding user response：

Will further explain my comment with an example.

First thing: You're using a private function and not having any input... a function will not act upon cells; it only outputs a value. You want to use a Subroutine to perform actions on cells.

Second bit: In your current code, you are checking each cell, and in each scenario that you check If cell.Value = myDate Then, you kick out your msgbox... if you have a long date list, that's a lot. You could resolve this by adding in check values and only doing the msgbox after the entire loop has been checked.

Alternatively, you could not do a loop at all and use Application.Match(), such that (untested):

Sub DateChecked()
    dim inquiryDate as date:  inquiryDate = ActiveCell.Value
    dim ws as worksheet:  set ws = ThisWorkbook.Sheets("History")
    dim dateRange as range:  set dateRange = ws.Range("CA1:CC1")
    if IsError(Application.Match(inquiryDate, dateRange, 0))=True then
        'Do something when you have no match
    end if
End Sub

CodePudding user response：

Thats the full answer code to my question for future reference.

Sub HistoryUpdate()

DateUpdateWithCheck

End Sub

Private Function DateUpdateWithCheck()

Dim ws As Worksheet
Dim wb As Workbook

Dim myDate As Date
Dim searchrange As Range
Dim cell As Range
Dim lRow As Long


myDate = Date

Set ws = ThisWorkbook.Worksheets("History")
ws.Activate

Set searchrange = ws.Range(Cells(1, "C"), Cells(1, "C").End(xlToRight))


If IsError(Application.Match(CDbl(myDate), searchrange, 0)) = True Then

With ws
    lRow = Range("C1").End(xlToRight).Offset(0, 1).Select
    
    ActiveCell.Value = Date
    ActiveCell.EntireColumn.Copy
    ActiveCell.EntireColumn.PasteSpecial xlPasteValues

    
End With

End If

End Function