Creating a code for last day of the week worked??

[Todd_M]

Hi-
I spent a good part of the day trying to figure out how to write a code for the following scenario:


Column "A" contains names (people)
column "B" to column "H" contain hours worked for each person, each day.
Column "B" header is Monday, "C" is Tuesday and so on....
So Jack(listed in cell "A2") worked 8 hours on Monday(8 listed in cell "B2"), worked 4 hours on Tuesday(4 listed in cell "C2"), was off on Wednesday(cell "D2" is blank), worked 8 hours on Thursday(8 listed in cell "E2"),was off on Friday(cell "F2" is blank),worked 8 hours on Saturday(8 listed in cell "G2") and off on sunday (cell "H2" is blank)

How would one write a code so that on saturday, a msgbox pops up to say that Jack needs to be paid? I Know how to create the msgbox, just need to know a code that will start on monday and look for the last day of the week that that person works. Then on that day show a msggbox.

 

[Jay Petrulis]

Hi Todd,

A couple of options that might work for you.

Both assume that there is nothing in column I -- it is blank for the range you need.

----------------
Sub test()
Dim lastrow As Long, x As Long, matchcol As Integer

If WeekDay(Date, vbMonday) = 6 Then

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To lastrow
matchcol = Cells(x, "I").End(xlToLeft).Column
If matchcol = 1 Then GoTo E
MsgBox Cells(x, 1) & " gets paid on " & Cells(1, matchcol)
E:
Next x
End If
End Sub
----------------------

To test it tonight, change
WeekDay(Date, vbMonday) = 6
to
WeekDay(Date, vbMonday) = 2

Also, if you would like to use an event macro triggered from a cell in a dropdown box, for instance, you might use something like:

------------------------
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim matchrow As Long, matchcol As Integer
On Error Resume Next
If Len(Target) = 0 Then Exit Sub
If Target.Address(False, False) = "J2" Then
matchrow = Evaluate("=MATCH(J2,A:A,0)")
matchcol = Cells(matchrow, "I").End(xlToLeft).Column
If matchrow = 0 Or matchcol = 1 Then Exit Sub
MsgBox Target & " gets paid on " & Cells(1, matchcol)
End If
End Sub
---------------------

This assumes that your entry cell is J2.

HTH,
Jay

 

[Todd_M]

Jay helped me out with the two codes from above. I used the first code for my needs seeing that im using a commandbutton to find the info Im looking for. The only problem is that when I click on the button, the msgbox goes through all names and the days that there supposed to be paid on. I only want to know who's supposed to be paid today (Wednesday), not for any other day of the week. When tommorow (Thursday) comes around, then I only want to know who gets paid on Thursday by selecting the commandbutton and so on.


Private Sub CommandButton1_Click()

Dim lastrow As Long, x As Long, matchcol As Integer

If Weekday(Date, vbMonday) = 3 Then
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To lastrow
matchcol = Cells(x, "I").End(xlToLeft).Column
If matchcol = 4 Then GoTo E
Next x
End If
E: MsgBox Cells(x, 1) & " gets paid today!" End Sub

By changing a couple of numbers around I was able to achieve my goal as I did in the above code, however if more than one person is supposed to be paid today, it does not post the next name. This code only posts the first name in a list of 20 names thats should be paid today. I still have 3 others that need to show "xxxx gets paid today!" .

Thanks Todd

 

[Jay Petrulis]

Hi Todd,

I guess I didn;t fully understand your request.

Here are two corrected versions for you to try.

The first assumes that the header days Sunday through Saturday (any order is fine) are text entries (e.g. "Monday"). The second assumes that they are date entries (e.g. 4/8/02 regardless of how they are formatted).

---------------------------
Sub test()
Dim lastrow As Long, x As Long
Dim matchday As Integer, matchcol As Integer
Dim myarr(1 To 7)

matchday = WorksheetFunction.Match(Format(Date, "dddd"), Rows("1:1"), 0)

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To lastrow
matchcol = Cells(x, "I").End(xlToLeft).Column
If matchcol <> matchday Then GoTo E
MsgBox Cells(x, 1) & " gets paid today."
E:
Next x
End Sub
----------------------------
----------------------------
Sub test2()
Dim lastrow As Long, x As Long
Dim matchday As Integer, matchcol As Integer
Dim myarr(1 To 7)

For x = 1 To 7
myarr(x) = WeekDay(Cells(1, x + 1), vbMonday)
Next x
matchday = WorksheetFunction.Match(WeekDay(Date, vbMonday), myarr, 0) + 1

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To lastrow
matchcol = Cells(x, "I").End(xlToLeft).Column
If matchcol <> matchday Then GoTo E
MsgBox Cells(x, 1) & " gets paid today."
E:
Next x
End Sub
---------------------------

Let us know how either of these turn out for you.

Bye,
Jay

 

[Todd_M]

I wonder how you guys are able to know this stuff. I can only assume that you been doing this for many years. It works great, Thanks so much!!!!!

 

[Todd_M]

Opps- one last problem, seeing that the code is looking for the last empty cell from column "I" in the row, even though it does work when the cell is empty, but when theres a formula like =S2 in cell B5 and even though cell S2 is blank and cell B5 is blank, I guess the code still reads cell B5 as having a formula. Is there anyway so that the code just reads if there actual text and not a formula? I didnt relize that it would have an impact ,sorry

Thanks once again!