SOLVED

Macro button to add value in corresponding cell

Brass Contributor

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

 

 

2 Replies
best response confirmed by Alecs (Brass Contributor)
Solution

@Alecs 

Assign 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
Thank you Hans! worked perfectly (as always :D )
Have a nice day!
1 best response

Accepted Solutions
best response confirmed by Alecs (Brass Contributor)
Solution

@Alecs 

Assign 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

View solution in original post