VBA button to lookup today's date and edit the cell next to it-CodePudding

I need help creating a VBA button which, when pressed, will lookup a specific cell in another worksheet that has today's date as value, and will edit the value of its adjacent cell by 1.

I am attempting to create a 'Points Tracker' for my studies. I will award myself one point for every task I complete. I have a workbook with two worksheets ('Sheet1' and 'data').

On the 'Sheet1' worksheet, I will have a visual look of my progress with a dynamic heatmap ranging from the past 27 weeks. Also a button at the top, which I intend to press every time I finish a task to add one point to my daily tally.

On the 'data' worksheet, I have a simple table with two colums (columnA will be the date ranging from 2022 to 2026 & columnB the points for each day.

I have managed to link the values in the columnB of the data's table to the dynamic heatmap in Sheet1, which means, when the points in columnB are edited, I will see them live in the heatmap. Now, I just need an easy way to add-up points to today's date in the data's table. Sort of like what Vlookup does, but instead of returning the value in the range's column2, I want to edit it by 1.

When searching for a solution, This question appears to be very similar to what I want to do, but it strayed away a bit from my intentions. I still tried the following, which results in an error:

Private Sub Worksheet_Change()
    Dim temp As Range
    If Not Intersect(Target, Range("E3")) Is Nothing Then
        Set temp = Range("data!A:A").Find(Trim(Range("E3")), LookIn:=xlValues, lookat:=xlWhole)
        If Not temp Is Nothing Then
            Range("K3") = temp.Offset(0, 1)
            temp.Offset(0, 2) = Range("Q3")
        End If
    End If
End Sub

Something else that I tried was to assign a specific cell in Sheet1 for today's points (Sheet1!$A$1), and then adding the following formula to the cells in columnB of the data table: =If(A1=TODAY(),Sheet1!$A$1,B1) This way, if I were to add a simple 1 button to that (Sheet1!$A$1), the data table would populate accordingly. However, there's a circular reference in that formula that messes up my heatmap.

I hope this is detailed enough and I thank you in advance for any help you can give! :)

CodePudding user response：

Personally, I would cut out the Intersect function as it's not really applicable and additionally change the event to Button1_Click since you only want it to run when the button is clicked anyways.

Sub Button1_Click()
    Dim temp As Range
    Set temp = Range("data!A:A").Find(What:=Format(Date, "d/m/yyyy"), LookIn:=xlValues, LookAt:=xlPart)
    
    If Not temp Is Nothing Then
        temp.Offset(0, 1).Value2 = temp.Offset(0, 1).Value2   1
    End If
End Sub

You would also ideally put this in your workbook's ThisWorkbook project.