Forum Discussion
Deleted
Jul 28, 2022VBA issue - Need code to match data elements between worksheets and a worksheet name and move/post
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,...
- Jul 28, 2022
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
HansVogelaar
Jul 28, 2022MVP
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.
- DeletedJul 28, 2022https://docs.google.com/spreadsheets/d/1PCBrB2kY-9RAkTBDPqcfpFmSOVy7FoRG/edit?usp=sharing&ouid=111406893368351115316&rtpof=true&sd=true
Thanks Hans!! Here is a Google Drive link.- HansVogelaarJul 28, 2022MVP
Deleted
I get "Access Denied". You'll need to share the file.
- DeletedJul 28, 2022Sorry Hans, please try again!