SOLVED

VBA issue - Need code to match data elements between worksheets and a worksheet name and move/post

Deleted
Not applicable

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!!!!Pic 1.pngPic 2.png

6 Replies

@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.

@Deleted 

I get "Access Denied". You'll need to share the file.

best response
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

@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.

1 best response

Accepted Solutions
best response
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

View solution in original post