Oct 29 2022 06:06 AM
Hello guys,
can you help me with this one?
I have a table that contains a list with projects. I need to book working hours for each project in a 12 months period (53 weeks).
I need your help for the following:
- in cell A4: insert week number (ex: w4)
- in cell B4: insert the number of working hours (ex 1:00)
- then click on a button that will automatically add in cell H4 value 1:00
the same needs to be done for all 53 weeks. The maximum number of projects is 150 (column C). There will be 20 Sheets where 20 different people will book their own projects (each person has one sheet).
!! one important thing: in case I added 2 days ago 1:00 hour to week4 and I need to add today 2:00 more hours to week4 >>> it needs to sum the new value to previous values (1:00 + 2:00), resulting: 3:00 hours.
Please open the excel file that I attached. I've marked with arrows all the process
let me know in case there is anything else needed :)
Thanks in advance!
Alecs
Oct 29 2022 07:28 AM
SolutionAssign the following macro to the Add shape:
Sub RoundedRectangle2_Click()
Dim wk As String
Dim rg As Range
Dim tm As Date
If Intersect(Range("B4:B10000"), ActiveCell) Is Nothing Then
MsgBox "Please select a cell with working hours in column B!", vbInformation
Exit Sub
End If
If ActiveCell.Offset(0, -1).Value = "" Then
MsgBox "Please select a cell with a week number to the left!", vbExclamation
Exit Sub
End If
If Val(ActiveCell.Value) <= 0 Then
MsgBox "Please enter a valid working time!", vbInformation
Exit Sub
End If
wk = ActiveCell.Offset(0, -1).Value
Set rg = Range("E2:BE2").Find(What:=wk, LookAt:=xlWhole)
If rg Is Nothing Then
MsgBox "Week number not found!", vbInformation
Exit Sub
End If
tm = Val(ActiveCell.Value)
With Cells(ActiveCell.Row, rg.Column)
.Value = .Value + tm
End With
End Sub
Oct 30 2022 08:36 AM
Oct 29 2022 07:28 AM
SolutionAssign the following macro to the Add shape:
Sub RoundedRectangle2_Click()
Dim wk As String
Dim rg As Range
Dim tm As Date
If Intersect(Range("B4:B10000"), ActiveCell) Is Nothing Then
MsgBox "Please select a cell with working hours in column B!", vbInformation
Exit Sub
End If
If ActiveCell.Offset(0, -1).Value = "" Then
MsgBox "Please select a cell with a week number to the left!", vbExclamation
Exit Sub
End If
If Val(ActiveCell.Value) <= 0 Then
MsgBox "Please enter a valid working time!", vbInformation
Exit Sub
End If
wk = ActiveCell.Offset(0, -1).Value
Set rg = Range("E2:BE2").Find(What:=wk, LookAt:=xlWhole)
If rg Is Nothing Then
MsgBox "Week number not found!", vbInformation
Exit Sub
End If
tm = Val(ActiveCell.Value)
With Cells(ActiveCell.Row, rg.Column)
.Value = .Value + tm
End With
End Sub