Forum Discussion

Alecs's avatar
Alecs
Brass Contributor
Oct 29, 2022
Solved

Macro button to add value in corresponding cell

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

 

 

  • 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
  • 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
    • Alecs's avatar
      Alecs
      Brass Contributor
      Thank you Hans! worked perfectly (as always 😄 )
      Have a nice day!

Resources