VBA solution for a tally sheet, add 1 to a cell based on current date

B

Burrgogi

Active Member
Joined
Nov 3, 2005
Messages
443
Office Version
  1. 2010
Platform
  1. Windows
I've got a simple tally sheet to count my FreeCell wins & losses. There are just 2 sheets in the workbook. The first one (we'll just call it "Sheet1") shows me the win percentage. I'm having some problems with the 2nd one ("Daily Count"). Here's what that 2nd sheet looks like:

Excel screenshot 3.png


I've got numbers 1 - 31 in column A representing the day of each month (starting at row 3). Up to now I have been manually adding 1 to the corresponding cell. For example today is the 27th of the month, if I win the next game, cell B29 would change from 1 to 2. It's gotten rather tedious to do by hand so I've put together a VBA routine to automate this. I'm not a programmer by any means so I did some 'google' searching. Through trial & error I've pieced together following routine. I need 2 things.

I've created 2 macros (wins & losses accordingly). The code below is for my wins.

1) The code currently changes the value in column B. That's fine because I'm dealing with April stats for now, but I would like the code to evaluate the current month and change accordingly. As you can see from my screenshot, I have the upcoming months next to April all the way through the end of the year.

2) I would like the loss column ("L") to display a zero if it is blank. Using today as an example, I would like cell C29 to display a ZERO when I run the macro. BUT ONLY if it is blank. Again, it won't always be cell C29 - it needs to change dynamically based on the current month.

Actually 1 last request.... I would like change ActiveSheet.Range("B2") in line 4 to Sheet1.Range("B2"). For some strange reason when I made the change, Excel threw up an error.

VBA Code: 
Sub Freecell_WIN_v2()
Dim theDay As Integer
theDay = Day(Date)
Dim Fnd As Range
ActiveSheet.Range("B2") = ActiveSheet.Range("B2").Value + 1
Set rRange = Sheets("Daily Count").Range("A3:A33")
    Set Fnd = rRange.Find(What:=theDay, LookIn:=xlValues, Lookat:=xlWhole)
    If Fnd Is Nothing Then
        MsgBox "Can't find today's date!"
        Exit Sub
    End If
    Fnd.Offset(0, 1).Value = Value + 1
End Sub
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Sort by date Sort by votes
Ideally you don't want to use Merged Cells in the heading but use Center Across Selection.
I don't have visibility over what you have in the Month heading cells. In the below I have assumed it is text but it would probably be better to make it an actual date (typically the 1st of the month). If it is a date then let me know and it will be a minor change to the code.

VBA Code: 
Sub Freecell_WIN_v3()
    Dim dtDate As Date
    Dim theDay As Long
    Dim theMonth As String                                          ' <--- This will depend on what is in the heading
    Dim offsetMonth As Long
    Dim wsDaily As Worksheet
    Dim wsSummary As Worksheet
    Dim Fnd As Range
    Dim rRange As Range
    Dim Value As Long
    
    Set wsDaily = Worksheets("Daily Count")                         ' <--- Change as required
    Set wsSummary = Worksheets("Sheet1")                            ' <--- Change as required
    
    dtDate = Date
    ' dtDate = DateSerial(2024, 5, 2)                               ' XXX Used for testing XXX
    theDay = Day(dtDate)
    theMonth = Format(dtDate, "mmm")
    
    With Application
        offsetMonth = .IfError(.Match(theMonth, wsDaily.Rows(1), 0) - 1, 0)
    End With
    
    If offsetMonth = 0 Then
        MsgBox "Can't find today's month!"
        Exit Sub
    End If
    
    wsSummary.Range("B2") = wsSummary.Range("B2").Value + 1         ' <--- Is this your intention
    
    Set rRange = wsDaily.Range("A3:A33")
    Set Fnd = rRange.Find(What:=theDay, LookIn:=xlValues, Lookat:=xlWhole)
    
    If Fnd Is Nothing Then
        MsgBox "Can't find today's date!"
        Exit Sub
    End If
    
    With Fnd.Offset(0, offsetMonth)
        .Value = .Value + 1                     ' Wins
    End With
    With Fnd.Offset(0, offsetMonth + 1)
        If .Value = "" Then .Value = 0          ' Losses
    End With
End Sub
 
Upvote 0
Solution
Alex, your code works great, thank you so much for your work on this! I very much appreciate this.

Would you mind explaining how the routine works? As I mentioned, I am a total novice when it comes to VBA coding so I would love to expand my knowledge a little and study your code.

Alex Blakenburg said:
Ideally you don't want to use Merged Cells in the heading but use Center Across Selection.
Click to expand...

It may appear as merged but they're not. I used the center across selection method.

Alex Blakenburg said:
wsSummary.Range("B2") = wsSummary.Range("B2").Value + 1 ' <--- Is this your intention
Click to expand...

I noticed your comment here. The answer is yes.
 
Upvote 0
Glad to hear you are using Center Across Selection, merged cells nearly always come back to bite you later.

I'm not sure how much of your original code you understood in terms of a starting point for comments.
• You were already using "Set" which is a pointer to an Object so I set up 2 extra ones, one for each sheet
• In Excel or Code I don't like to use Today() or Date directly in a formula. You inevitably want to force it run on a specific date and that makes it hard to do, this normally raises its head when you want to test that it works. For that reason I added the linedtDate = Date . The equivalent in Excel would be to put Today() in a cell and use that cell in your formulas.
• We need to work out what column to use for the month. The standard Excel Match function looking for the month in the heading and starting in column 1 will give you the column no.
Since the Column mths are text in the form "mmm" we need to convert the date we are using to a text value of "mmm" before putting it in match
(the VBA Format() = Excel Text() )
We are using Offset to get to the column. A2 offset(0,1) already takes you to column B so if my column no for April is 2 I have to take one off the offset number (column 2 - 1 = offset of 1)
• With / End This saves you repeating the object reference and has performance benefits.
eg
Rng.Value = 10
Rng.Font.Bold = True
becomes
With Rng
.Value = 10
.Font.Bold = True
End With

Happy to answer and specific questions you have.
 
Upvote 0
Alex Blakenburg said:
I'm not sure how much of your original code you understood in terms of a starting point for comments.
Click to expand...

I never had any formal training or took classes in VBA so I know just enough to be dangerous. I know how to declare variables using Dim statement and piece together very simple & basic scripts - just like I did with my first attempt which I posted above. That's about it. And yes, I do have some questions.

I guess we'll start with the basics. I need some knowledge on what variable types are. Date & String is self explanatory. In the solution you provided, I noticed:
VBA Code: 
Dim Value As Long

1. What does Long mean? I have also seen "Double" in some VBA scripts. I have no clue what they are.

2. A little further down in the code, I saw this:
VBA Code: 
' dtDate = DateSerial(2024, 5, 2)                               ' XXX Used for testing XXX

You commented that line out. Why?

Also I'm curious what DateSerial does. When I was googling for a solution on my own, I saw a couple of different scripts using that (DateSerial). 2024 represents the year obviously but what does 5 and 2 represent?

3. I see you assigned a variable named dtDate equal to the current date. dtDate = Date. But I am confused what the following 2 lines do:
VBA Code: 
theDay = Day(dtDate)
theMonth = Format(dtDate, "mmm")
 
Upvote 0
Burrgogi said:
1. What does Long mean? I have also seen "Double" in some VBA scripts. I have no clue what they are.
Click to expand...
1) Long is just a bigger version of Integer. There is an argument that Integer gets converted under the hood to Long so its more efficient to use Long
Double is for larger decimal numbers but you need to be aware that it is a floating point container and as such is subject to floating point errors. This happens in Excel too you will occasionally see numbers with a lots of decimal places when you weren't expecting it.
You are better off looking at the list itself that you can find here.
learn.microsoft.com

Data type summary

Office VBA reference topic
learn.microsoft.com

2) dtDate = DateSerial(2024, 5, 2)
you wanted the code to use Today which is the function Date and applied with dtDate = Date
But I needed to test other dates in particular other months, so I needed to be able to set dtDate to different dates.
DateSerial(yyyy, mm, dd) is the equivalent to Excel's "=date(year, month, day)". Since VBA works using US Date format DateSerial can not be misinterpreted whereas using a date string can result in month and date being inverted.

3) Date extraction
theDay = Day(dtDate) is the same as =Day(datevalue) in Excel it just returns the number representing the day ie Day of 10 Nov 2024 returns 10
theMonth = Format(dtDate, "mmm"), your headings are text values Jan Feb Mar Apr so Format(10 November 2024) returns Nov as text
(Excel equivalent is =Text(DateValue, "mmm") )
 
Upvote 0
OK, so regarding item # 2 explanation: (2024, 5, 2)
- does this mean you were using May 2, 2024 just for testing purposes?

I have another follow up question. Some of my month name headers are 4 letters instead of 3. As an example:
Sept
Oct

The solution you provided works smoothly provided that the months are abbreviated with 3 letters. Is there a quick & easy method to adjust the script in order to account for months such as Sept?

I was thinking of modifying this line:
VBA Code: 
theMonth = Format(dtDate, "mmm")

to this:

VBA Code: 
theMonth = Format(dtDate, "mmm") Or Format(dtDate, "mmmm")

EDIT: one more question. Going back to my original posting:

"Actually 1 last request.... I would like change ActiveSheet.Range("B2") in line 4 to Sheet1.Range("B2"). For some strange reason when I made the change, Excel (VBA) threw up an error."

I'd really like to understand what I was doing wrong here.
 
Last edited:
Upvote 0
Burrgogi said:
OK, so regarding item # 2 explanation: (2024, 5, 2)
- does this mean you were using May 2, 2024 just for testing purposes?
Click to expand...
Yes
Burrgogi said:
The solution you provided works smoothly provided that the months are abbreviated with 3 letters. Is there a quick & easy method to adjust the script in order to account for months such as Sept?
Click to expand...
You will end up hardcoding the month's that vary. It would be much easier to change your headings to be consistent. Users should be used to that anyway.
If you applied a custom date format in Excel it would only have 3 letters or the full month.
Note: "mmmm" returns the full month name ie September

Burrgogi said:
Sheet1.Range("B2")
Click to expand...
You either need to have Set Sheet1 = Worksheets("NameOfSheet") or Sheet1 has to be the Code Name of the sheet.
In the below Sheet1 is the Code Name and I have changed the visible Name of the Sheet to "This is Sheet 1".


1714373214826.png
 
Upvote 0
Alex Blakenburg said:
You either need to have Set Sheet1 = Worksheets("NameOfSheet") or Sheet1 has to be the Code Name of the sheet.
In the below Sheet1 is the Code Name and I have changed the visible Name of the Sheet to "This is Sheet 1".


View attachment 110667
Click to expand...

Took me a while to process what you were saying. I didn't even know there was such a thing as "code name" for a worksheet. I'm assuming that the "code name" is not the same thing as the worksheet name that appears in the tab?

Thanks for the explanations.
 
Upvote 0
Correct in the previous image, the first name you see in the properties window (and the objects window) is the code name.
You can effectively only change that in Developer mode and the user doesn't see that name. One of the main reasons for using it is that if the user changes the sheet name, the code name stays unchanged and the routine will not be impacted.
If you are going to use it please change it to something meaningful. The code name only works if you are referring to a sheet that is in the same workbook that holds the code.
 
Upvote 1
You must log in or register to reply here.

Similar threads

D
  • Question
Tally that shifts cells daily.
Replies
3
Views
184
portews
P
D
  • Solved
Open Certain Worksheet Based on Current Date
Replies
8
Views
371
NdNoviceHlp
NdNoviceHlp
P
  • Question
Need VBA to automatically copy paste rows based on dates of current month.
2
Replies
11
Views
438
pk970
P
O
  • Solved
Icon Set Conditional Format from other cell value
Replies
3
Views
550
ollyhughes1982
O
A
  • Solved
Auto-Update Date Based on Cell Input
Replies
8
Views
239
acool
A

Forum statistics

Threads
1,216,500
Messages
6,131,015
Members
449,615
Latest member
Nic0la

Share this page

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