Jul 28 2022 01:49 PM
Jul 28 2022 01:49 PM
I'm trying to automate a spreadsheet we use at work to capture hours worked on certain projects. I've got it 80% of the way there except for some code I need to write.
On the top of my main sheet, I have a dropdown with 3 employee names to select from.
I also have a dropdown for "Segment". I have 6 segments in the dropdown, each pertain to a roughly 2 week period.
In the table below, I have three dropdowns for the Project name. This is in case someone works on more than one project for the "Segment". The dates in rows 3/4 change dynamically from the chosen "Segment".
I put in some dummy data in the hours worked as you see.
I want some VBA that can match the employee name, to the projects chosen and post the number of ours inputted into that employee's worksheet.
In this pic, I have "Alex Waldorama" having worked some hours in Segment 5 (Dec 1 to Dec 16 - which is dynamically updated based on segment chosen).
"Alex Waldorama" has a separate worksheet with Project 1 to Project 10 as columns, and every day date for Oct 1, 2022 to Sept 30, 2023. I want this code to post hours from pic 1 into the separate spreadsheet. So it should be able to match the employee name to the Worksheet name, and the intersect Month & Day to Project and input these hours into that worksheet.
I hope this makes sense, as I'm not nearly as smart as all of you answering these questions!!! Thanks for all you do to help saps like me make it in life!!!
One last thing, say someone goes back in and puts hours in again and posts... it should be able override what they put in before.
I'm gonna place a square with the VBA so they can just click the Shape (macro will run) and the hours will post. Thanks!!!!
Jul 28 2022 02:06 PM
@Deleted
Could you attach a sample workbook (without sensitive data), or if that is not possible, make it available through OneDrive, Google Drive, Dropbox or similar? Thanks in advance.
Jul 28 2022 02:13 PM
Jul 28 2022 02:26 PM
@Deleted
I get "Access Denied". You'll need to share the file.
Jul 28 2022 02:35 PM
Jul 28 2022 03:33 PM
Solution@Deleted
Thanks. I have attached the workbook with a command button that executes a macro. I have added lots of comments to the macro.
The workbook is now a macro-enabled workbook (.xlsm), so you'll have to allow macros when you open it.
If that doesn't work, here is the code:
Sub PostHours()
Dim wI As Worksheet
Dim e As String
Dim wE As Worksheet
Dim dS As String
Dim rS As Range
Dim dE As String
Dim rE As Range
Dim r As Range
Dim rH As Range
Dim h As Double
Dim d As String
Dim p As String
Dim rD As Range
Dim rP As Range
' Time input sheet
Set wI = Worksheets("Time Input")
' Employee
e = wI.Range("B1").Value
' Employee sheet
Set wE = Worksheets(e)
' Start date of segment
dS = wI.Range("B5").Value
' Cell with start date on employee sheet
Set rS = wE.Range("A:A").Find(What:=dS, LookAt:=xlWhole)
' end date of segment
dE = wI.Range("Q5").Value
' Cell with end date on employrr sheet
Set rE = wE.Range("A:A").Find(What:=dE, LookAt:=xlWhole)
' Clear hours in date range
wE.Range(rS, rE).Offset(0, 1).Resize(, 10).ClearContents
' Range with hours
On Error Resume Next
Set rH = wI.Range("B7:Q9").SpecialCells(xlCellTypeConstants)
On Error GoTo 0
' If range is empty, we're done
If rH Is Nothing Then Exit Sub
' Loop
For Each r In rH
' Hours
h = r.Value
' Date
d = wI.Cells(5, r.Column).Value
' Date header cell
Set rD = wE.Range("A:A").Find(What:=d, LookAt:=xlWhole)
' Project
p = wI.Cells(r.Row, 1).Value
' Project header cell
Set rP = wE.Range("1:1").Find(What:=p, LookAt:=xlWhole)
' Fill cell with hours
wE.Cells(rD.Row, rP.Column).Value = h
Next r
End Sub
Jul 28 2022 03:41 PM
@Hans Vogelaar... oh my Gosh... this is so beautiful man!!! WOW!!!! Thank you so much Hans!!!!
I am going to play with it further tomorrow.... thank you again. I really appreciate you Hans.
Jul 28 2022 03:33 PM
Solution@Deleted
Thanks. I have attached the workbook with a command button that executes a macro. I have added lots of comments to the macro.
The workbook is now a macro-enabled workbook (.xlsm), so you'll have to allow macros when you open it.
If that doesn't work, here is the code:
Sub PostHours()
Dim wI As Worksheet
Dim e As String
Dim wE As Worksheet
Dim dS As String
Dim rS As Range
Dim dE As String
Dim rE As Range
Dim r As Range
Dim rH As Range
Dim h As Double
Dim d As String
Dim p As String
Dim rD As Range
Dim rP As Range
' Time input sheet
Set wI = Worksheets("Time Input")
' Employee
e = wI.Range("B1").Value
' Employee sheet
Set wE = Worksheets(e)
' Start date of segment
dS = wI.Range("B5").Value
' Cell with start date on employee sheet
Set rS = wE.Range("A:A").Find(What:=dS, LookAt:=xlWhole)
' end date of segment
dE = wI.Range("Q5").Value
' Cell with end date on employrr sheet
Set rE = wE.Range("A:A").Find(What:=dE, LookAt:=xlWhole)
' Clear hours in date range
wE.Range(rS, rE).Offset(0, 1).Resize(, 10).ClearContents
' Range with hours
On Error Resume Next
Set rH = wI.Range("B7:Q9").SpecialCells(xlCellTypeConstants)
On Error GoTo 0
' If range is empty, we're done
If rH Is Nothing Then Exit Sub
' Loop
For Each r In rH
' Hours
h = r.Value
' Date
d = wI.Cells(5, r.Column).Value
' Date header cell
Set rD = wE.Range("A:A").Find(What:=d, LookAt:=xlWhole)
' Project
p = wI.Cells(r.Row, 1).Value
' Project header cell
Set rP = wE.Range("1:1").Find(What:=p, LookAt:=xlWhole)
' Fill cell with hours
wE.Cells(rD.Row, rP.Column).Value = h
Next r
End Sub